[project @ 2004-10-03 17:13:34 by panne]
[ghc-hetmet.git] / ghc / rts / Interpreter.c
index cc18059..74f2454 100644 (file)
@@ -4,12 +4,7 @@
  * Copyright (c) The GHC Team, 1994-2002.
  * ---------------------------------------------------------------------------*/
 
-#if !defined(SMP)
 #include "PosixSource.h"
-#else
-/* Hack and slash.. */
-#include "Stg.h"
-#endif
 #include "Rts.h"
 #include "RtsAPI.h"
 #include "RtsUtils.h"
 #include "Schedule.h"
 #include "RtsFlags.h"
 #include "Storage.h"
+#include "LdvProfile.h"
 #include "Updates.h"
 #include "Sanity.h"
+#include "Liveness.h"
 
 #include "Bytecodes.h"
 #include "Printer.h"
@@ -115,22 +112,22 @@ void interp_startup ( void )
 void interp_shutdown ( void )
 {
    int i, j, k, o_max, i_max, j_max;
-   fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
+   debugBelch("%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
                    it_retto_BCO + it_retto_UPDATE + it_retto_other,
                    it_retto_BCO, it_retto_UPDATE, it_retto_other );
-   fprintf(stderr, "%d total entries, %d unknown entries \n", 
+   debugBelch("%d total entries, %d unknown entries \n", 
                    it_total_entries, it_total_unknown_entries);
    for (i = 0; i < N_CLOSURE_TYPES; i++) {
      if (it_unknown_entries[i] == 0) continue;
-     fprintf(stderr, "   type %2d: unknown entries (%4.1f%%) == %d\n",
+     debugBelch("   type %2d: unknown entries (%4.1f%%) == %d\n",
             i, 100.0 * ((double)it_unknown_entries[i]) / 
                         ((double)it_total_unknown_entries),
              it_unknown_entries[i]);
    }
-   fprintf(stderr, "%d insns, %d slides, %d BCO_entries\n", 
+   debugBelch("%d insns, %d slides, %d BCO_entries\n", 
                    it_insns, it_slides, it_BCO_entries);
    for (i = 0; i < 27; i++) 
-      fprintf(stderr, "opcode %2d got %d\n", i, it_ofreq[i] );
+      debugBelch("opcode %2d got %d\n", i, it_ofreq[i] );
 
    for (k = 1; k < 20; k++) {
       o_max = 0;
@@ -144,7 +141,7 @@ void interp_shutdown ( void )
         }
       }
       
-      fprintf ( stderr, "%d:  count (%4.1f%%) %6d   is %d then %d\n",
+      debugBelch("%d:  count (%4.1f%%) %6d   is %d then %d\n",
                 k, ((double)o_max) * 100.0 / ((double)it_insns), o_max,
                    i_max, j_max );
       it_oofreq[i_max][j_max] = 0;
@@ -165,7 +162,6 @@ static StgWord app_ptrs_itbl[] = {
     (W_)&stg_ap_pppp_info,
     (W_)&stg_ap_ppppp_info,
     (W_)&stg_ap_pppppp_info,
-    (W_)&stg_ap_ppppppp_info
 };
 
 StgThreadReturnCode
@@ -233,14 +229,14 @@ eval_obj:
     INTERP_TICK(it_total_evals);
 
     IF_DEBUG(interpreter,
-             fprintf(stderr, 
+             debugBelch(
              "\n---------------------------------------------------------------\n");
-             fprintf(stderr,"Evaluating: "); printObj(obj);
-             fprintf(stderr,"Sp = %p\n", Sp);
-             fprintf(stderr, "\n" );
+             debugBelch("Evaluating: "); printObj(obj);
+             debugBelch("Sp = %p\n", Sp);
+             debugBelch("\n" );
 
              printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-             fprintf(stderr, "\n\n");
+             debugBelch("\n\n");
             );
 
     IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
@@ -332,7 +328,7 @@ eval_obj:
     {
        // Can't handle this object; yield to scheduler
        IF_DEBUG(interpreter,
-                fprintf(stderr, "evaluating unknown closure -- yielding to sched\n"); 
+                debugBelch("evaluating unknown closure -- yielding to sched\n"); 
                 printObj(obj);
            );
        Sp -= 2;
@@ -349,13 +345,13 @@ do_return:
     ASSERT(closure_HNF(obj));
 
     IF_DEBUG(interpreter,
-             fprintf(stderr, 
+             debugBelch(
              "\n---------------------------------------------------------------\n");
-             fprintf(stderr,"Returning: "); printObj(obj);
-             fprintf(stderr,"Sp = %p\n", Sp);
-             fprintf(stderr, "\n" );
+             debugBelch("Returning: "); printObj(obj);
+             debugBelch("Sp = %p\n", Sp);
+             debugBelch("\n" );
              printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-             fprintf(stderr, "\n\n");
+             debugBelch("\n\n");
             );
 
     IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
@@ -400,9 +396,6 @@ do_return:
        if (info == (StgInfoTable *)&stg_ap_pppppp_info) {
            n = 6; m = 6; goto do_apply;
        }
-       if (info == (StgInfoTable *)&stg_ap_ppppppp_info) {
-           n = 7; m = 7; goto do_apply;
-       }
        goto do_return_unrecognised;
     }
 
@@ -430,7 +423,7 @@ do_return:
        // Can't handle this return address; yield to scheduler
        INTERP_TICK(it_retto_other);
        IF_DEBUG(interpreter,
-                fprintf(stderr, "returning to unknown frame -- yielding to sched\n"); 
+                debugBelch("returning to unknown frame -- yielding to sched\n"); 
                 printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
            );
        Sp -= 2;
@@ -493,7 +486,7 @@ do_return_unboxed:
            // Can't handle this return address; yield to scheduler
            INTERP_TICK(it_retto_other);
            IF_DEBUG(interpreter,
-                    fprintf(stderr, "returning to unknown frame -- yielding to sched\n"); 
+                    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);
@@ -737,18 +730,18 @@ run_BCO:
        ASSERT(bciPtr <= instrs[0]);
        IF_DEBUG(interpreter,
                 //if (do_print_stack) {
-                //fprintf(stderr, "\n-- BEGIN stack\n");
+                //debugBelch("\n-- BEGIN stack\n");
                 //printStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
-                //fprintf(stderr, "-- END stack\n\n");
+                //debugBelch("-- END stack\n\n");
                 //}
-                fprintf(stderr,"Sp = %p   pc = %d      ", Sp, bciPtr);
+                debugBelch("Sp = %p   pc = %d      ", Sp, bciPtr);
                 disInstr(bco,bciPtr);
                 if (0) { int i;
-                fprintf(stderr,"\n");
+                debugBelch("\n");
                 for (i = 8; i >= 0; i--) {
-                    fprintf(stderr, "%d  %p\n", i, (StgPtr)(*(Sp+i)));
+                    debugBelch("%d  %p\n", i, (StgPtr)(*(Sp+i)));
                 }
-                fprintf(stderr,"\n");
+                debugBelch("\n");
                 }
                 //if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
            );
@@ -815,7 +808,7 @@ run_BCO:
 
        case bci_PUSH_ALTS: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1p_info;
+           Sp[-2] = (W_)&stg_ctoi_R1p_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -823,7 +816,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_P: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1unpt_info;
+           Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -831,7 +824,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_N: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_R1n_info;
+           Sp[-2] = (W_)&stg_ctoi_R1n_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -839,7 +832,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_F: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_F1_info;
+           Sp[-2] = (W_)&stg_ctoi_F1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -847,7 +840,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_D: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_D1_info;
+           Sp[-2] = (W_)&stg_ctoi_D1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -855,7 +848,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_L: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_L1_info;
+           Sp[-2] = (W_)&stg_ctoi_L1_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -863,7 +856,7 @@ run_BCO:
 
        case bci_PUSH_ALTS_V: {
            int o_bco  = BCO_NEXT;
-           Sp[-2] = (W_)&stg_ctoi_ret_V_info;
+           Sp[-2] = (W_)&stg_ctoi_V_info;
            Sp[-1] = BCO_PTR(o_bco);
            Sp -= 2;
            goto nextInsn;
@@ -902,9 +895,6 @@ run_BCO:
        case bci_PUSH_APPLY_PPPPPP:
            Sp--; Sp[0] = (W_)&stg_ap_pppppp_info;
            goto nextInsn;
-       case bci_PUSH_APPLY_PPPPPPP:
-           Sp--; Sp[0] = (W_)&stg_ap_ppppppp_info;
-           goto nextInsn;
            
        case bci_PUSH_UBX: {
            int i;
@@ -973,7 +963,7 @@ run_BCO:
                ap->payload[i] = (StgClosure*)Sp[i+1];
            Sp += n_payload+1;
            IF_DEBUG(interpreter,
-                    fprintf(stderr,"\tBuilt "); 
+                    debugBelch("\tBuilt "); 
                     printObj((StgClosure*)ap);
                );
            goto nextInsn;
@@ -1008,7 +998,7 @@ run_BCO:
            Sp --;
            Sp[0] = (W_)con;
            IF_DEBUG(interpreter,
-                    fprintf(stderr,"\tBuilt "); 
+                    debugBelch("\tBuilt "); 
                     printObj((StgClosure*)con);
                );
            goto nextInsn;
@@ -1018,7 +1008,7 @@ run_BCO:
            int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
-           if (constrTag(con) >= discr) {
+           if (GET_TAG(con) >= discr) {
                bciPtr = failto;
            }
            goto nextInsn;
@@ -1028,7 +1018,7 @@ run_BCO:
            int discr  = BCO_NEXT;
            int failto = BCO_NEXT;
            StgClosure* con = (StgClosure*)Sp[0];
-           if (constrTag(con) != discr) {
+           if (GET_TAG(con) != discr) {
                bciPtr = failto;
            }
            goto nextInsn;
@@ -1191,11 +1181,11 @@ run_BCO:
            // on the stack frame to describe this chunk of stack.
            //
            Sp -= ret_dyn_size;
-           ((StgRetDyn *)Sp)->liveness = ALL_NON_PTRS | N_NONPTRS(stk_offset);
+           ((StgRetDyn *)Sp)->liveness = NO_PTRS | N_NONPTRS(stk_offset);
            ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
 
            SAVE_STACK_POINTERS;
-           tok = suspendThread(&cap->r,rtsFalse);
+           tok = suspendThread(&cap->r);
 
 #ifndef RTS_SUPPORTS_THREADS
            // Careful:
@@ -1212,7 +1202,7 @@ run_BCO:
 #endif
 
            // And restart the thread again, popping the RET_DYN frame.
-           cap = (Capability *)((void *)((unsigned char*)resumeThread(tok,rtsFalse) - sizeof(StgFunTable)));
+           cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - sizeof(StgFunTable)));
            LOAD_STACK_POINTERS;
            Sp += ret_dyn_size;