[project @ 2005-08-09 16:08:03 by simonpj]

[ghc-hetmet.git] / ghc / rts / Interpreter.c

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index 74f2454..004bb6f 100644 (file)
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -43,7 +43,7 @@
 
 #define BCO_NEXT      instrs[bciPtr++]
 #define BCO_PTR(n)    (W_)ptrs[n]
-#define BCO_LIT(n)    (W_)literals[n]
+#define BCO_LIT(n)    literals[n]
 #define BCO_ITBL(n)   itbls[n]
 
 #define LOAD_STACK_POINTERS                                    \
@@ -55,8 +55,14 @@
     cap->r.rCurrentTSO->sp = Sp
 
 #define RETURN_TO_SCHEDULER(todo,retcode)      \
-   SAVE_STACK_POINTERS;                        \
-   cap->r.rCurrentTSO->what_next = (todo);      \
+   SAVE_STACK_POINTERS;                                \
+   cap->r.rCurrentTSO->what_next = (todo);     \
+   threadPaused(cap->r.rCurrentTSO);           \
+   return (retcode);
+
+#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)     \
+   SAVE_STACK_POINTERS;                                \
+   cap->r.rCurrentTSO->what_next = (todo);     \
    return (retcode);
 
 
@@ -334,7 +340,7 @@ eval_obj:
        Sp -= 2;
        Sp[1] = (W_)obj;
        Sp[0] = (W_)&stg_enter_info;
-       RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+       RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
     }
 
@@ -429,7 +435,7 @@ do_return:
        Sp -= 2;
        Sp[1] = (W_)obj;
        Sp[0] = (W_)&stg_enter_info;
-       RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+       RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
     }
 
@@ -489,7 +495,7 @@ do_return_unboxed:
                     debugBelch("returning to unknown frame -- yielding to sched\n"); 
                     printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
                );
-           RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+           RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
        }
        }
     }
@@ -508,7 +514,7 @@ do_apply:
 
        case PAP: {
            StgPAP *pap;
-           nat arity, i;
+           nat i, arity;
 
            pap = (StgPAP *)obj;
 
@@ -528,7 +534,8 @@ do_apply:
                // Shuffle the args for this function down, and put
                // the appropriate info table in the gap.
                for (i = 0; i < arity; i++) {
-                   Sp[i-1] = Sp[i];
+                   Sp[(int)i-1] = Sp[i];
+                   // ^^^^^ careful, i-1 might be negative, but i in unsigned
                }
                Sp[arity-1] = app_ptrs_itbl[n-arity-1];
                Sp--;
@@ -584,7 +591,8 @@ do_apply:
                // Shuffle the args for this function down, and put
                // the appropriate info table in the gap.
                for (i = 0; i < arity; i++) {
-                   Sp[i-1] = Sp[i];
+                   Sp[(int)i-1] = Sp[i];
+                   // ^^^^^ careful, i-1 might be negative, but i in unsigned
                }
                Sp[arity-1] = app_ptrs_itbl[n-arity-1];
                Sp--;
@@ -618,7 +626,7 @@ do_apply:
            Sp -= 2;
            Sp[1] = (W_)obj;
            Sp[0] = (W_)&stg_enter_info;
-           RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+           RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
 
     // ------------------------------------------------------------------------
@@ -902,7 +910,7 @@ run_BCO:
            int n_words = BCO_NEXT;
            Sp -= n_words;
            for (i = 0; i < n_words; i++) {
-               Sp[i] = BCO_LIT(o_lits+i);
+               Sp[i] = (W_)BCO_LIT(o_lits+i);
            }
            goto nextInsn;
        }
@@ -1005,7 +1013,7 @@ run_BCO:
        }
 
        case bci_TESTLT_P: {
-           int discr  = BCO_NEXT;
+           unsigned int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
            if (GET_TAG(con) >= discr) {
@@ -1015,7 +1023,7 @@ run_BCO:
        }
 
        case bci_TESTEQ_P: {
-           int discr  = BCO_NEXT;
+           unsigned int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
            if (GET_TAG(con) != discr) {