Add a new primitive forkOn#, for forking a thread on a specific Capability
[ghc-hetmet.git] / ghc / rts / Disassembler.c
index 8b526c0..b084a29 100644 (file)
@@ -1,12 +1,11 @@
-
 /* -----------------------------------------------------------------------------
  * Bytecode disassembler
  *
- * Copyright (c) 1994-1998.
+ * Copyright (c) 1994-2002.
  *
  * $RCSfile: Disassembler.c,v $
- * $Revision: 1.25 $
- * $Date: 2002/07/17 09:21:49 $
+ * $Revision: 1.29 $
+ * $Date: 2004/09/03 15:28:19 $
  * ---------------------------------------------------------------------------*/
 
 #ifdef DEBUG
 #include "Disassembler.h"
 #include "Interpreter.h"
 
-#include <stdio.h>
-
 /* --------------------------------------------------------------------------
  * Disassembler
  * ------------------------------------------------------------------------*/
 
-int disInstr ( StgBCO *bco, int pc )
+int
+disInstr ( StgBCO *bco, int pc )
 {
    int i;
 
-   StgArrWords*   instr_arr   = bco->instrs;
-   UShort*        instrs      = (UShort*)(&instr_arr->payload[0]);
+   StgWord16*     instrs      = (StgWord16*)(bco->instrs->payload);
 
    StgArrWords*   literal_arr = bco->literals;
    StgWord*       literals    = (StgWord*)(&literal_arr->payload[0]);
@@ -48,119 +45,190 @@ int disInstr ( StgBCO *bco, int pc )
 
    switch (instrs[pc++]) {
       case bci_SWIZZLE:
-         fprintf(stderr, "SWIZZLE stkoff %d by %d\n",
+         debugBelch("SWIZZLE stkoff %d by %d\n",
                          instrs[pc], (signed int)instrs[pc+1]);
          pc += 2; break;
       case bci_CCALL:
-         fprintf(stderr, "CCALL    marshaller at 0x%x\n", 
+         debugBelch("CCALL    marshaller at 0x%x\n", 
                          literals[instrs[pc]] );
          pc += 1; break;
       case bci_STKCHECK: 
-         fprintf(stderr, "STKCHECK %d\n", instrs[pc] );
-         pc += 1; break;
-      case bci_ARGCHECK: 
-         fprintf(stderr, "ARGCHECK %d\n", instrs[pc] );
+         debugBelch("STKCHECK %d\n", instrs[pc] );
          pc += 1; break;
       case bci_PUSH_L: 
-         fprintf(stderr, "PUSH_L   %d\n", instrs[pc] );
+         debugBelch("PUSH_L   %d\n", instrs[pc] );
          pc += 1; break;
       case bci_PUSH_LL:
-         fprintf(stderr, "PUSH_LL  %d %d\n", instrs[pc], instrs[pc+1] ); 
+         debugBelch("PUSH_LL  %d %d\n", instrs[pc], instrs[pc+1] ); 
          pc += 2; break;
       case bci_PUSH_LLL:
-         fprintf(stderr, "PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1], 
+         debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1], 
                                                             instrs[pc+2] ); 
          pc += 3; break;
       case bci_PUSH_G:
-         fprintf(stderr, "PUSH_G   " ); printPtr( ptrs[instrs[pc]] );
-         fprintf(stderr, "\n" );
+         debugBelch("PUSH_G   " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n" );
          pc += 1; break;
-      case bci_PUSH_AS:
-         fprintf(stderr, "PUSH_AS  " ); printPtr( ptrs[instrs[pc]] );
-         fprintf(stderr, " 0x%x", literals[instrs[pc+1]] );
-         fprintf(stderr, "\n");
-         pc += 2; break;
+
+      case bci_PUSH_ALTS:
+         debugBelch("PUSH_ALTS  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_P:
+         debugBelch("PUSH_ALTS_P  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_N:
+         debugBelch("PUSH_ALTS_N  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_F:
+         debugBelch("PUSH_ALTS_F  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_D:
+         debugBelch("PUSH_ALTS_D  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_L:
+         debugBelch("PUSH_ALTS_L  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_ALTS_V:
+         debugBelch("PUSH_ALTS_V  " ); printPtr( ptrs[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+
       case bci_PUSH_UBX:
-         fprintf(stderr, "PUSH_UBX ");
+         debugBelch("PUSH_UBX ");
          for (i = 0; i < instrs[pc+1]; i++) 
-            fprintf(stderr, "0x%x ", literals[i + instrs[pc]] );
-         fprintf(stderr, "\n");
+            debugBelch("0x%x ", literals[i + instrs[pc]] );
+         debugBelch("\n");
          pc += 2; break;
-      case bci_PUSH_TAG:
-         fprintf(stderr, "PUSH_TAG %d\n", instrs[pc] );
-         pc += 1; break;
+      case bci_PUSH_APPLY_N:
+         debugBelch("PUSH_APPLY_N\n");
+         break;
+      case bci_PUSH_APPLY_V:
+         debugBelch("PUSH_APPLY_V\n");
+         break;
+      case bci_PUSH_APPLY_F:
+         debugBelch("PUSH_APPLY_F\n");
+         break;
+      case bci_PUSH_APPLY_D:
+         debugBelch("PUSH_APPLY_D\n");
+         break;
+      case bci_PUSH_APPLY_L:
+         debugBelch("PUSH_APPLY_L\n");
+         break;
+      case bci_PUSH_APPLY_P:
+         debugBelch("PUSH_APPLY_P\n");
+         break;
+      case bci_PUSH_APPLY_PP:
+         debugBelch("PUSH_APPLY_PP\n");
+         break;
+      case bci_PUSH_APPLY_PPP:
+         debugBelch("PUSH_APPLY_PPP\n");
+         break;
+      case bci_PUSH_APPLY_PPPP:
+         debugBelch("PUSH_APPLY_PPPP\n");
+         break;
+      case bci_PUSH_APPLY_PPPPP:
+         debugBelch("PUSH_APPLY_PPPPP\n");
+         break;
+      case bci_PUSH_APPLY_PPPPPP:
+         debugBelch("PUSH_APPLY_PPPPPP\n");
+         break;
       case bci_SLIDE: 
-         fprintf(stderr, "SLIDE    %d down by %d\n", instrs[pc], instrs[pc+1] );
+         debugBelch("SLIDE     %d down by %d\n", instrs[pc], instrs[pc+1] );
          pc += 2; break;
-      case bci_ALLOC:
-         fprintf(stderr, "ALLOC    %d words\n", instrs[pc] );
+      case bci_ALLOC_AP:
+         debugBelch("ALLOC_AP  %d words\n", instrs[pc] );
          pc += 1; break;
+      case bci_ALLOC_PAP:
+         debugBelch("ALLOC_PAP %d words, %d arity\n",
+                instrs[pc], instrs[pc+1] );
+         pc += 2; break;
       case bci_MKAP:
-         fprintf(stderr, "MKAP     %d words, %d stkoff\n", instrs[pc+1], 
+         debugBelch("MKAP      %d words, %d stkoff\n", instrs[pc+1], 
                                                            instrs[pc] );
          pc += 2; break;
       case bci_UNPACK:
-         fprintf(stderr, "UNPACK   %d\n", instrs[pc] );
+         debugBelch("UNPACK    %d\n", instrs[pc] );
          pc += 1; break;
-      case bci_UPK_TAG:
-         fprintf(stderr, "UPK_TAG  %d words, %d conoff, %d stkoff\n",
-                         instrs[pc], instrs[pc+1], instrs[pc+2] );
-         pc += 3; break;
       case bci_PACK:
-         fprintf(stderr, "PACK     %d words with itbl ", instrs[pc+1] );
+         debugBelch("PACK      %d words with itbl ", instrs[pc+1] );
          printPtr( (StgPtr)itbls[instrs[pc]] );
-         fprintf(stderr, "\n");
+         debugBelch("\n");
          pc += 2; break;
 
-      case bci_CASEFAIL: 
-         fprintf(stderr, "CASEFAIL\n" );
-         break;
-      case bci_JMP:
-         fprintf(stderr, "JMP to   %d\n", instrs[pc]);
-         pc += 1; break;
-
       case bci_TESTLT_I:
-         fprintf(stderr, "TESTLT_I %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTLT_I  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_I:
-         fprintf(stderr, "TESTEQ_I %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTEQ_I  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
 
       case bci_TESTLT_F:
-         fprintf(stderr, "TESTLT_F %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTLT_F  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_F:
-         fprintf(stderr, "TESTEQ_F %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTEQ_F  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
 
       case bci_TESTLT_D:
-         fprintf(stderr, "TESTLT_D %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTLT_D  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_D:
-         fprintf(stderr, "TESTEQ_D %d, fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTEQ_D  %d, fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
 
       case bci_TESTLT_P:
-         fprintf(stderr, "TESTLT_P %d, fail to %d\n", instrs[pc],
+         debugBelch("TESTLT_P  %d, fail to %d\n", instrs[pc],
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_P:
-         fprintf(stderr, "TESTEQ_P %d, fail to %d\n", instrs[pc],
+         debugBelch("TESTEQ_P  %d, fail to %d\n", instrs[pc],
                                                       instrs[pc+1]);
          pc += 2; break;
-      case bci_RETURN:
-         fprintf(stderr, "RETURN  " ); printPtr( (StgPtr)itbls[instrs[pc]] );
-         fprintf(stderr, "\n");
+      case bci_CASEFAIL: 
+         debugBelch("CASEFAIL\n" );
+         break;
+      case bci_JMP:
+         debugBelch("JMP to    %d\n", instrs[pc]);
          pc += 1; break;
+
       case bci_ENTER:
-         fprintf(stderr, "ENTER\n");
+         debugBelch("ENTER\n");
          break;
+
+      case bci_RETURN:
+         debugBelch("RETURN\n" );
+        break;
+      case bci_RETURN_P:
+         debugBelch("RETURN_P\n" );
+        break;
+      case bci_RETURN_N:
+         debugBelch("RETURN_N\n" );
+        break;
+      case bci_RETURN_F:
+         debugBelch("RETURN_F\n" );
+        break;
+      case bci_RETURN_D:
+         debugBelch("RETURN_D\n" );
+        break;
+      case bci_RETURN_L:
+         debugBelch("RETURN_L\n" );
+        break;
+      case bci_RETURN_V:
+         debugBelch("RETURN_V\n" );
+        break;
+
       default:
          barf("disInstr: unknown opcode");
    }
@@ -176,38 +244,37 @@ int disInstr ( StgBCO *bco, int pc )
 void disassemble( StgBCO *bco )
 {
    nat i, j;
-   StgArrWords*   instr_arr = bco->instrs;
-   UShort*        instrs    = (UShort*)(&instr_arr->payload[0]);
+   StgWord16*     instrs    = (StgWord16*)(bco->instrs->payload);
    StgMutArrPtrs* ptrs      = bco->ptrs;
    nat            nbcs      = (int)instrs[0];
    nat            pc        = 1;
 
-   fprintf(stderr, "BCO\n" );
+   debugBelch("BCO\n" );
    pc = 1;
    while (pc <= nbcs) {
-      fprintf(stderr, "\t%2d:  ", pc );
+      debugBelch("\t%2d:  ", pc );
       pc = disInstr ( bco, pc );
    }
 
-   fprintf(stderr, "INSTRS:\n   " );
+   debugBelch("INSTRS:\n   " );
    j = 16;
    for (i = 0; i < nbcs; i++) {
-      fprintf(stderr, "%3d ", (int)instrs[i] );
+      debugBelch("%3d ", (int)instrs[i] );
       j--; 
-      if (j == 0) { j = 16; fprintf(stderr, "\n   "); };
+      if (j == 0) { j = 16; debugBelch("\n   "); };
    }
-   fprintf(stderr, "\n");
+   debugBelch("\n");
 
-   fprintf(stderr, "PTRS:\n   " );
+   debugBelch("PTRS:\n   " );
    j = 8;
    for (i = 0; i < ptrs->ptrs; i++) {
-      fprintf(stderr, "%8p ", ptrs->payload[i] );
+      debugBelch("%8p ", ptrs->payload[i] );
       j--; 
-      if (j == 0) { j = 8; fprintf(stderr, "\n   "); };
+      if (j == 0) { j = 8; debugBelch("\n   "); };
    }
-   fprintf(stderr, "\n");
+   debugBelch("\n");
 
-   fprintf(stderr, "\n");
+   debugBelch("\n");
    ASSERT(pc == nbcs+1);
 }