The GHC 4 runtime system was written before GCC 3.5 deprecated lvalue
casts. The runtime system's sources are littered with these casts, so
the biggest part of this patch is to rewrite those statements to a
standards compliant form. This allows us to build the runtime with a
more recent C compiler.
Problematic is also the assembly in the bundled sources of GMP 2.0.2,
which spans multiple lines without escaping line breaks.
TODO: We aren't yet using anything under ghc/compiler, so the patches
there aren't needed at this time. The intent was to ensure that the
compiler sources can be used even when they are interpreted by Hugs.
import Constants -- Default values for some flags
import FastString ( headFS )
import Maybes ( assocMaybe, firstJust, maybeToBool )
-import Panic ( panic, panic# )
+import Panic ( panic, panic' )
-#if __GLASGOW_HASKELL__ < 301
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 301
import ArrBase ( Array(..) )
#else
import PrelArr ( Array(..) )
tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(260)
tagOf_PrimOp DataToTagOp = ILIT(261)
tagOf_PrimOp TagToEnumOp = ILIT(262)
-tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
+tagOf_PrimOp op = pprPanic' "tagOf_PrimOp: pattern-match" (ppr op)
instance Eq PrimOp where
op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
module Outputable (
-- error handling
- pprPanic, pprPanic#, pprError, pprTrace, assertPprPanic, warnPprTrace,
- trace, panic, panic#, assertPanic
+ pprPanic, pprPanic', pprError, pprTrace, assertPprPanic, warnPprTrace,
+ trace, panic, panic', assertPanic
) where
#include "HsVersions.h"
pprPanic = pprAndThen panic
pprError = pprAndThen error
pprTrace = pprAndThen trace
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
+pprPanic' heading pretty_msg = panic' (show (doc PprDebug))
where
doc = text heading <+> pretty_msg
It's hard to put these functions anywhere else without causing
some unnecessary loops in the module dependency graph.
\begin{code}
-module Panic ( panic, panic#, assertPanic, trace ) where
+module Panic ( panic, panic', assertPanic, trace ) where
import IOExts ( trace )
panic x = error ("panic! (the `impossible' happened):\n\t"
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
-- No, man -- Too Beautiful! (Will)
-panic# :: String -> FAST_INT
-panic# s = case (panic s) of () -> ILIT(0)
+panic' :: String -> FAST_INT
+panic' s = case (panic s) of () -> ILIT(0)
assertPanic :: String -> Int -> a
assertPanic file line = panic ("ASSERT failed! file " ++ file ++ ", line " ++ show line)
EXTFUN_RTS(mkForeignObjzh_fast);
#define STG_SIG_ERR (-3)
#define STG_SIG_HAN (-4)
+#include <signal.h>
extern StgInt sig_install (StgInt, StgInt, StgStablePtr, sigset_t *);
#define stg_sig_default(sig,mask) sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask)
#define stg_sig_ignore(sig,mask) sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask)
typedef struct StgTSO_ {
extern StgTSO dummy_tso;
#define TSO_STRUCT_SIZE \
- ((int)&(dummy_tso).stack - (int)&(dummy_tso).header)
+ ((char *)&dummy_tso.stack - (char *)&dummy_tso.header)
#define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_))
freeMegaGroup(bdescr *p)
nat n;
n = p->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
- for (; n > 0; (W_)p += MBLOCK_SIZE, n--) {
+ for (; n > 0; p = (W_)p + MBLOCK_SIZE, n--) {
initMBlock((void *)((W_)p & ~MBLOCK_MASK));
initGroup(BLOCKS_PER_MBLOCK, p);
freeGroup(p);
initMBlock(void *mblock)
/* Initialise the start field of each block descriptor
*/
- for (; block <= LAST_BLOCK(mblock); bd += 1, (lnat)block += BLOCK_SIZE) {
+ for (; block <= LAST_BLOCK(mblock); bd += 1, block = (lnat)block + BLOCK_SIZE) {
bd->start = block;
}
}
StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
static inline void PushTag ( StackTag t )
{ *(--gSp) = t; }
inline void PushPtr ( StgPtr x )
- { *(--stgCast(StgPtr*,gSp)) = x; }
+ { gSp -= sizeof(StgPtr); *(stgCast(StgPtr *, gSp)) = x; }
static inline void PushCPtr ( StgClosure* x )
- { *(--stgCast(StgClosure**,gSp)) = x; }
+ { gSp -= sizeof(StgClosure*); *(stgCast(StgClosure **,gSp)) = x; }
static inline void PushInt ( StgInt x )
- { *(--stgCast(StgInt*,gSp)) = x; }
+ { gSp -= sizeof(StgInt); *(stgCast(StgInt *,gSp)) = x; }
static inline void PushWord ( StgWord x )
- { *(--stgCast(StgWord*,gSp)) = x; }
+ { gSp -= sizeof(StgWord); *(stgCast(StgWord*,gSp)) = x; }
static inline void checkTag ( StackTag t1, StackTag t2 )
traverse_weak_ptr_list(void)
next = t->global_link;
*prev = next;
continue;
- default:
+ default: continue;
}
/* Threads which have already been determined to be alive are
* moved onto the all_threads list.
*/
- (StgClosure *)tmp = isAlive((StgClosure *)t);
+ tmp = (StgTSO *) isAlive((StgClosure *)t);
if (tmp != NULL) {
next = tmp->global_link;
tmp->global_link = all_threads;
traverse_weak_ptr_list(void)
StgTSO *t, *tmp, *next;
for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
next = t->global_link;
- (StgClosure *)tmp = evacuate((StgClosure *)t);
+ tmp = (StgTSO *) evacuate((StgClosure *)t);
tmp->global_link = resurrected_threads;
resurrected_threads = tmp;
}
cleanup_weak_ptr_list ( StgWeak **list )
}
if (Bdescr((P_)w)->evacuated == 0) {
- (StgClosure *)w = evacuate((StgClosure *)w);
+ w = (StgWeak *) evacuate((StgClosure *)w);
*last_w = w;
}
last_w = &(w->link);
static void
scavengeTSO (StgTSO *tso)
{
/* chase the link field for any TSOs on the same queue */
- (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
+ tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnException
scavenge(step *step)
{
StgMVar *mvar = ((StgMVar *)p);
evac_gen = 0;
- (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
- (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
- (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
p += sizeofW(StgMVar);
evac_gen = saved_evac_gen;
break;
scavenge(step *step)
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
p += info->layout.payload.nptrs;
break;
scavenge(step *step)
case BLACKHOLE_BQ:
{
StgBlockingQueue *bh = (StgBlockingQueue *)p;
- (StgClosure *)bh->blocking_queue =
- evacuate((StgClosure *)bh->blocking_queue);
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)bh);
scavenge(step *step)
evac_gen = 0; /* repeatedly mutable */
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
evac_gen = saved_evac_gen;
break;
scavenge(step *step)
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
if (failed_to_evac) {
/* we can do this easier... */
scavenge(step *step)
// char str[80];
// StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
StgRBH *rbh = (StgRBH *)p;
- (StgClosure *)rbh->blocking_queue =
- evacuate((StgClosure *)rbh->blocking_queue);
+ rbh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)rbh->blocking_queue);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)rbh);
scavenge(step *step)
{
StgBlockedFetch *bf = (StgBlockedFetch *)p;
/* follow the pointer to the node which is being demanded */
- (StgClosure *)bf->node =
- evacuate((StgClosure *)bf->node);
+ bf->node =
+ (StgTSO *)evacuate((StgClosure *)bf->node);
/* follow the link to the rest of the blocking queue */
- (StgClosure *)bf->link =
- evacuate((StgClosure *)bf->link);
+ bf->link =
+ (StgTSO *)evacuate((StgClosure *)bf->link);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)bf);
scavenge(step *step)
case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
{
StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
- (StgClosure *)fmbq->blocking_queue =
- evacuate((StgClosure *)fmbq->blocking_queue);
+ fmbq->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)fmbq->blocking_queue);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)fmbq);
scavenge_one(StgClosure *p)
end = (P_)p->payload + info->layout.payload.ptrs;
for (q = (P_)p->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgTSO *)evacuate((StgClosure *)*q);
}
break;
}
scavenge_mutable_list(generation *gen)
end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
evac_gen = gen->no;
for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgTSO *)evacuate((StgClosure *)*q);
}
evac_gen = 0;
scavenge_mutable_list(generation *gen)
end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgTSO *)evacuate((StgClosure *)*q);
}
continue;
}
scavenge_mutable_list(generation *gen)
case MVAR:
{
StgMVar *mvar = (StgMVar *)p;
- (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
- (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
- (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
p->mut_link = gen->mut_list;
gen->mut_list = p;
continue;
scavenge_mutable_list(generation *gen)
case BLACKHOLE_BQ:
{
StgBlockingQueue *bh = (StgBlockingQueue *)p;
- (StgClosure *)bh->blocking_queue =
- evacuate((StgClosure *)bh->blocking_queue);
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
p->mut_link = gen->mut_list;
gen->mut_list = p;
continue;
scavenge_mutable_list(generation *gen)
// char str[80];
// StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
StgRBH *rbh = (StgRBH *)p;
- (StgClosure *)rbh->blocking_queue =
- evacuate((StgClosure *)rbh->blocking_queue);
+ rbh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)rbh->blocking_queue);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)rbh);
scavenge_mutable_list(generation *gen)
{
StgBlockedFetch *bf = (StgBlockedFetch *)p;
/* follow the pointer to the node which is being demanded */
- (StgClosure *)bf->node =
+ bf->node =
evacuate((StgClosure *)bf->node);
/* follow the link to the rest of the blocking queue */
- (StgClosure *)bf->link =
- evacuate((StgClosure *)bf->link);
+ bf->link =
+ (StgTSO *)evacuate((StgClosure *)bf->link);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)bf);
scavenge_mutable_list(generation *gen)
case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
{
StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
- (StgClosure *)fmbq->blocking_queue =
- evacuate((StgClosure *)fmbq->blocking_queue);
+ fmbq->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)fmbq->blocking_queue);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
recordMutable((StgMutClosure *)fmbq);
scavenge_static(void)
next = (P_)p->payload + info->layout.payload.ptrs;
/* evacuate the pointers */
for (q = (P_)p->payload; q < next; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgTSO *)evacuate((StgClosure *)*q);
}
break;
}
scavenge_stack(StgPtr p, StgPtr stack_end)
/* otherwise, must be a pointer into the allocation space. */
#endif
- (StgClosure *)*p = evacuate((StgClosure *)q);
+ *p = (StgTSO *)evacuate((StgClosure *)q);
p++;
continue;
}
scavenge_stack(StgPtr p, StgPtr stack_end)
small_bitmap:
while (bitmap != 0) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
p++;
bitmap = bitmap >> 1;
scavenge_stack(StgPtr p, StgPtr stack_end)
q = p + sizeof(W_) * 8;
while (bitmap != 0) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
p++;
bitmap = bitmap >> 1;
}
if (i+1 < large_bitmap->size) {
while (p < q) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
p++;
}
}
scavenge_large(step *step)
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
continue;
}
scavenge_large(step *step)
evac_gen = saved_evac_gen; /* not really mutable */
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgTSO *)evacuate((StgClosure *)*p);
}
evac_gen = 0;
if (failed_to_evac) {
threadSqueezeStack(StgTSO *tso)
sp -= 1;
}
}
- (P_)prev_frame = (P_)frame + displacement;
+ prev_frame = (P_)frame + displacement;
frame = next_frame;
}
process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error)
} else if (RtsFlags.GranFlags.proc > MAX_PROC ||
RtsFlags.GranFlags.proc < 1)
{
- fprintf(stderr,"setupRtsFlags: no more than %u processors
-allowed\n",
+ fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n",
MAX_PROC);
*error = rtsTrue;
}
detectBlackHoles( void )
break;
}
- done:
+ done: continue;
}
}
lookupStableName(StgPtr p)
*/
p = (StgPtr)removeIndirections((StgClosure*)p);
- (void *)sn = lookupHashTable(addrToStableHash,(W_)p);
+ sn = (StgWord*)(void *)lookupHashTable(addrToStableHash,(W_)p);
if (sn != 0) {
ASSERT(stable_ptr_table[sn].addr == p);
lookupStableName(StgPtr p)
return sn;
} else {
sn = stable_ptr_free - stable_ptr_table;
- (P_)stable_ptr_free = stable_ptr_free->addr;
+ stable_ptr_free = (snEntry*)(P_)(stable_ptr_free->addr);
stable_ptr_table[sn].weight = 0;
stable_ptr_table[sn].addr = p;
stable_ptr_table[sn].sn_obj = NULL;
markStablePtrTable(rtsBool full)
if (full) {
insertHashTable(addrToStableHash, (W_)new,
(void *)(p - stable_ptr_table));
- (StgClosure *)p->addr = new;
+ p->addr = (StgClosure *)new;
} else if ((P_)new != q) {
removeHashTable(addrToStableHash, (W_)q, NULL);
if (!lookupHashTable(addrToStableHash, (W_)new)) {
insertHashTable(addrToStableHash, (W_)new,
(void *)(p - stable_ptr_table));
}
- (StgClosure *)p->addr = new;
+ p->addr = (StgClosure *)new;
}
IF_DEBUG(stable, fprintf(stderr,"Stable ptr %d still alive at %p, weight %u\n", p - stable_ptr_table, new, p->weight));
}
gcStablePtrTable(rtsBool full)
IF_DEBUG(stable, fprintf(stderr,"GC'd Stable name %d\n", p - stable_ptr_table));
}
else {
- (StgClosure *)new = isAlive((StgClosure *)q);
+ new = (StgTSO *)isAlive((StgClosure *)q);
IF_DEBUG(stable, fprintf(stderr,"Stable name %d still alive at %p, weight %d\n", p - stable_ptr_table, new, p->weight));
if (new == NULL) {
MA 02111-1307, USA. */
#if (defined (__a29k__) || defined (_AM29K)) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("add %1,%4,%5
+ __asm__ ("add %1,%4,%5\n\
addc %0,%2,%3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
MA 02111-1307, USA. */
"%r" ((USItype)(al)), \
"rI" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("sub %1,%4,%5
+ __asm__ ("sub %1,%4,%5\n\
subc %0,%2,%3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
#if defined (__arm__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("adds %1, %4, %5
+ __asm__ ("adds %1, %4, %5\n\
adc %0, %2, %3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
"%r" ((USItype)(al)), \
"rI" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subs %1, %4, %5
+ __asm__ ("subs %1, %4, %5\n\
sbc %0, %2, %3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
"r" ((USItype)(al)), \
"rI" ((USItype)(bl)))
#define umul_ppmm(xh, xl, a, b) \
- __asm__ ("%@ Inlined umul_ppmm
- mov %|r0, %2, lsr #16
- mov %|r2, %3, lsr #16
- bic %|r1, %2, %|r0, lsl #16
- bic %|r2, %3, %|r2, lsl #16
- mul %1, %|r1, %|r2
- mul %|r2, %|r0, %|r2
- mul %|r1, %0, %|r1
- mul %0, %|r0, %0
- adds %|r1, %|r2, %|r1
- addcs %0, %0, #65536
- adds %1, %1, %|r1, lsl #16
+ __asm__ ("%@ Inlined umul_ppmm\n\
+ mov %|r0, %2, lsr #16\n\
+ mov %|r2, %3, lsr #16\n\
+ bic %|r1, %2, %|r0, lsl #16\n\
+ bic %|r2, %3, %|r2, lsl #16\n\
+ mul %1, %|r1, %|r2\n\
+ mul %|r2, %|r0, %|r2\n\
+ mul %|r1, %0, %|r1\n\
+ mul %0, %|r0, %0\n\
+ adds %|r1, %|r2, %|r1\n\
+ addcs %0, %0, #65536\n\
+ adds %1, %1, %|r1, lsl #16\n\
adc %0, %0, %|r1, lsr #16" \
: "=&r" ((USItype)(xh)), \
"=r" ((USItype)(xl)) \
extern UDItype __udiv_qrnnd ();
#if defined (__gmicro__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("add.w %5,%1
+ __asm__ ("add.w %5,%1\n\
addx %3,%0" \
: "=g" ((USItype)(sh)), \
"=&g" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"g" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("sub.w %5,%1
+ __asm__ ("sub.w %5,%1\n\
subx %3,%0" \
: "=g" ((USItype)(sh)), \
"=&g" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
#if defined (__hppa) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("add %4,%5,%1
+ __asm__ ("add %4,%5,%1\n\
addc %2,%3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern UDItype __udiv_qrnnd ();
"%rM" ((USItype)(al)), \
"rM" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("sub %4,%5,%1
+ __asm__ ("sub %4,%5,%1\n\
subb %2,%3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
do { \
USItype __tmp; \
__asm__ ( \
- "ldi 1,%0
- extru,= %1,15,16,%%r0 ; Bits 31..16 zero?
- extru,tr %1,15,16,%1 ; No. Shift down, skip add.
- ldo 16(%0),%0 ; Yes. Perform add.
- extru,= %1,23,8,%%r0 ; Bits 15..8 zero?
- extru,tr %1,23,8,%1 ; No. Shift down, skip add.
- ldo 8(%0),%0 ; Yes. Perform add.
- extru,= %1,27,4,%%r0 ; Bits 7..4 zero?
- extru,tr %1,27,4,%1 ; No. Shift down, skip add.
- ldo 4(%0),%0 ; Yes. Perform add.
- extru,= %1,29,2,%%r0 ; Bits 3..2 zero?
- extru,tr %1,29,2,%1 ; No. Shift down, skip add.
- ldo 2(%0),%0 ; Yes. Perform add.
- extru %1,30,1,%1 ; Extract bit 1.
- sub %0,%1,%0 ; Subtract it.
+ "ldi 1,%0\n\
+ extru,= %1,15,16,%%r0 ; Bits 31..16 zero?\n\
+ extru,tr %1,15,16,%1 ; No. Shift down, skip add.\n\
+ ldo 16(%0),%0 ; Yes. Perform add.\n\
+ extru,= %1,23,8,%%r0 ; Bits 15..8 zero?\n\
+ extru,tr %1,23,8,%1 ; No. Shift down, skip add.\n\
+ ldo 8(%0),%0 ; Yes. Perform add.\n\
+ extru,= %1,27,4,%%r0 ; Bits 7..4 zero?\n\
+ extru,tr %1,27,4,%1 ; No. Shift down, skip add.\n\
+ ldo 4(%0),%0 ; Yes. Perform add.\n\
+ extru,= %1,29,2,%%r0 ; Bits 3..2 zero?\n\
+ extru,tr %1,29,2,%1 ; No. Shift down, skip add.\n\
+ ldo 2(%0),%0 ; Yes. Perform add.\n\
+ extru %1,30,1,%1 ; Extract bit 1.\n\
+ sub %0,%1,%0 ; Subtract it.\n\
" : "=r" (count), "=r" (__tmp) : "1" (x)); \
} while (0)
#endif /* hppa */
extern USItype __udiv_qrnnd ();
#if (defined (__i386__) || defined (__i486__)) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("addl %5,%1
+ __asm__ ("addl %5,%1\n\
adcl %3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"g" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subl %5,%1
+ __asm__ ("subl %5,%1\n\
sbbl %3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
#if (defined (__mc68000__) || defined (__mc68020__) || defined (__NeXT__) || defined(mc68020)) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("add%.l %5,%1
+ __asm__ ("add%.l %5,%1\n\
addx%.l %3,%0" \
: "=d" ((USItype)(sh)), \
"=&d" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"g" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("sub%.l %5,%1
+ __asm__ ("sub%.l %5,%1\n\
subx%.l %3,%0" \
: "=d" ((USItype)(sh)), \
"=&d" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
#else /* not mc68020 */
#define umul_ppmm(xh, xl, a, b) \
do { USItype __umul_tmp1, __umul_tmp2; \
- __asm__ ("| Inlined umul_ppmm
- move%.l %5,%3
- move%.l %2,%0
- move%.w %3,%1
- swap %3
- swap %0
- mulu %2,%1
- mulu %3,%0
- mulu %2,%3
- swap %2
- mulu %5,%2
- add%.l %3,%2
- jcc 1f
- add%.l %#0x10000,%0
-1: move%.l %2,%3
- clr%.w %2
- swap %2
- swap %3
- clr%.w %3
- add%.l %3,%1
- addx%.l %2,%0
+ __asm__ ("| Inlined umul_ppmm\n\
+ move%.l %5,%3\n\
+ move%.l %2,%0\n\
+ move%.w %3,%1\n\
+ swap %3\n\
+ swap %0\n\
+ mulu %2,%1\n\
+ mulu %3,%0\n\
+ mulu %2,%3\n\
+ swap %2\n\
+ mulu %5,%2\n\
+ add%.l %3,%2\n\
+ jcc 1f\n\
+ add%.l %#0x10000,%0\n\
+1: move%.l %2,%3\n\
+ clr%.w %2\n\
+ swap %2\n\
+ swap %3\n\
+ clr%.w %3\n\
+ add%.l %3,%1\n\
+ addx%.l %2,%0\n\
| End inlined umul_ppmm" \
: "=&d" ((USItype)(xh)), "=&d" ((USItype)(xl)), \
"=d" (__umul_tmp1), "=&d" (__umul_tmp2) \
extern USItype __udiv_qrnnd ();
#if defined (__m88000__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("addu.co %1,%r4,%r5
+ __asm__ ("addu.co %1,%r4,%r5\n\
addu.ci %0,%r2,%r3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%rJ" ((USItype)(al)), \
"rJ" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subu.co %1,%r4,%r5
+ __asm__ ("subu.co %1,%r4,%r5\n\
subu.ci %0,%r2,%r3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"d" ((USItype)(v)))
#else
#define umul_ppmm(w1, w0, u, v) \
- __asm__ ("multu %2,%3
- mflo %0
+ __asm__ ("multu %2,%3\n\
+ mflo %0\n\
mfhi %1" \
: "=d" ((USItype)(w0)), \
"=d" ((USItype)(w1)) \
extern USItype __udiv_qrnnd ();
"d" ((UDItype)(v)))
#else
#define umul_ppmm(w1, w0, u, v) \
- __asm__ ("dmultu %2,%3
- mflo %0
+ __asm__ ("dmultu %2,%3\n\
+ mflo %0\n\
mfhi %1" \
: "=d" ((UDItype)(w0)), \
"=d" ((UDItype)(w1)) \
extern USItype __udiv_qrnnd ();
#if defined (__pyr__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("addw %5,%1
+ __asm__ ("addw %5,%1\n\
addwc %3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"g" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subw %5,%1
+ __asm__ ("subw %5,%1\n\
subwb %3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
({union {UDItype __ll; \
struct {USItype __h, __l;} __i; \
} __xx; \
- __asm__ ("movw %1,%R0
+ __asm__ ("movw %1,%R0\n\
uemul %2,%0" \
: "=&r" (__xx.__ll) \
: "g" ((USItype) (u)), \
extern USItype __udiv_qrnnd ();
#if defined (__ibm032__) /* RT/ROMP */ && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("a %1,%5
+ __asm__ ("a %1,%5\n\
ae %0,%3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"r" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("s %1,%5
+ __asm__ ("s %1,%5\n\
se %0,%3" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
do { \
USItype __m0 = (m0), __m1 = (m1); \
__asm__ ( \
- "s r2,r2
- mts r10,%2
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- m r2,%3
- cas %0,r2,r0
+ "s r2,r2\n\
+ mts r10,%2\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ m r2,%3\n\
+ cas %0,r2,r0\n\
mfs r10,%1" \
: "=r" ((USItype)(ph)), \
"=r" ((USItype)(pl)) \
extern USItype __udiv_qrnnd ();
#if defined (__sh2__) && W_TYPE_SIZE == 32
#define umul_ppmm(w1, w0, u, v) \
__asm__ ( \
- "dmulu.l %2,%3
- sts macl,%1
+ "dmulu.l %2,%3\n\
+ sts macl,%1\n\
sts mach,%0" \
: "=r" ((USItype)(w1)), \
"=r" ((USItype)(w0)) \
extern USItype __udiv_qrnnd ();
#if defined (__sparc__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("addcc %r4,%5,%1
+ __asm__ ("addcc %r4,%5,%1\n\
addx %r2,%3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"rI" ((USItype)(bl)) \
__CLOBBER_CC)
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subcc %r4,%5,%1
+ __asm__ ("subcc %r4,%5,%1\n\
subx %r2,%3,%0" \
: "=r" ((USItype)(sh)), \
"=&r" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"r" ((USItype)(v)))
#define UMUL_TIME 5
#define udiv_qrnnd(q, r, n1, n0, d) \
- __asm__ ("! Inlined udiv_qrnnd
- wr %%g0,%2,%%y ! Not a delayed write for sparclite
- tst %%g0
- divscc %3,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%%g1
- divscc %%g1,%4,%0
- rd %%y,%1
- bl,a 1f
- add %1,%4,%1
+ __asm__ ("! Inlined udiv_qrnnd\n\
+ wr %%g0,%2,%%y ! Not a delayed write for sparclite\n\
+ tst %%g0\n\
+ divscc %3,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%%g1\n\
+ divscc %%g1,%4,%0\n\
+ rd %%y,%1\n\
+ bl,a 1f\n\
+ add %1,%4,%1\n\
1: ! End of inline udiv_qrnnd" \
: "=r" ((USItype)(q)), \
"=r" ((USItype)(r)) \
extern USItype __udiv_qrnnd ();
/* Default to sparc v7 versions of umul_ppmm and udiv_qrnnd. */
#ifndef umul_ppmm
#define umul_ppmm(w1, w0, u, v) \
- __asm__ ("! Inlined umul_ppmm
- wr %%g0,%2,%%y ! SPARC has 0-3 delay insn after a wr
- sra %3,31,%%g2 ! Don't move this insn
- and %2,%%g2,%%g2 ! Don't move this insn
- andcc %%g0,0,%%g1 ! Don't move this insn
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,%3,%%g1
- mulscc %%g1,0,%%g1
- add %%g1,%%g2,%0
+ __asm__ ("! Inlined umul_ppmm\n\
+ wr %%g0,%2,%%y ! SPARC has 0-3 delay insn after a wr\n\
+ sra %3,31,%%g2 ! Don't move this insn\n\
+ and %2,%%g2,%%g2 ! Don't move this insn\n\
+ andcc %%g0,0,%%g1 ! Don't move this insn\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,%3,%%g1\n\
+ mulscc %%g1,0,%%g1\n\
+ add %%g1,%%g2,%0\n\
rd %%y,%1" \
: "=r" ((USItype)(w1)), \
"=r" ((USItype)(w0)) \
extern USItype __udiv_qrnnd ();
#if defined (__vax__) && W_TYPE_SIZE == 32
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
- __asm__ ("addl2 %5,%1
+ __asm__ ("addl2 %5,%1\n\
adwc %3,%0" \
: "=g" ((USItype)(sh)), \
"=&g" ((USItype)(sl)) \
extern USItype __udiv_qrnnd ();
"%1" ((USItype)(al)), \
"g" ((USItype)(bl)))
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
- __asm__ ("subl2 %5,%1
+ __asm__ ("subl2 %5,%1\n\
sbwc %3,%0" \
: "=g" ((USItype)(sh)), \
"=&g" ((USItype)(sl)) \
module CPUTime
(
getCPUTime, -- :: IO Integer
- cpuTimePrecision -- ::\240Integer
+ cpuTimePrecision -- :: Integer
) where
\end{code}