-/* -*- mode: hugs-c; -*- */
/* -----------------------------------------------------------------------------
* Bytecode disassembler
*
- * Copyright (c) 1994-1998.
+ * Copyright (c) 1994-2002.
*
* $RCSfile: Disassembler.c,v $
- * $Revision: 1.2 $
- * $Date: 1998/12/02 13:28:15 $
+ * $Revision: 1.29 $
+ * $Date: 2004/09/03 15:28:19 $
* ---------------------------------------------------------------------------*/
-#include "Rts.h"
-
-#ifdef INTERPRETER
+#ifdef DEBUG
+#include "PosixSource.h"
+#include "Rts.h"
+#include "RtsAPI.h"
#include "RtsUtils.h"
+#include "Closures.h"
+#include "TSO.h"
+#include "Schedule.h"
+
#include "Bytecodes.h"
-#include "Assembler.h"
#include "Printer.h"
#include "Disassembler.h"
+#include "Interpreter.h"
/* --------------------------------------------------------------------------
* Disassembler
* ------------------------------------------------------------------------*/
-static InstrPtr disNone ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disInt ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disIntInt ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disInfo ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disConstPtr ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disConstInt ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disConstChar ( StgBCO *bco, InstrPtr pc, char* i );
-static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i );
-
-static InstrPtr disNone ( StgBCO *bco, InstrPtr pc, char* i )
+int
+disInstr ( StgBCO *bco, int pc )
{
- fprintf(stderr,"%s",i);
- return pc;
-}
+ int i;
-static InstrPtr disInt ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInt x = bcoInstr(bco,pc++);
- ASSERT(pc < bco->n_instrs);
- fprintf(stderr,"%s %d",i,x);
- return pc;
-}
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
-static InstrPtr disIntInt ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInt x = bcoInstr(bco,pc++);
- StgInt y = bcoInstr(bco,pc++);
- fprintf(stderr,"%s %d %d",i,x,y);
- return pc;
-}
+ StgArrWords* literal_arr = bco->literals;
+ StgWord* literals = (StgWord*)(&literal_arr->payload[0]);
-static InstrPtr disIntPC ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInt x = bcoInstr(bco,pc++);
- StgWord y = bcoInstr(bco,pc++);
- fprintf(stderr,"%s %d %d",i,x,pc+y);
- return pc;
-}
+ StgMutArrPtrs* ptrs_arr = bco->ptrs;
+ StgPtr* ptrs = (StgPtr*)(&ptrs_arr->payload[0]);
-static InstrPtr disPC ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgWord y = bcoInstr(bco,pc++);
- fprintf(stderr,"%s %d",i,pc+y);
- return pc;
-}
+ StgArrWords* itbls_arr = bco->itbls;
+ StgInfoTable** itbls = (StgInfoTable**)(&itbls_arr->payload[0]);
-static InstrPtr disInfo ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInfoTable* info = bcoConstInfoPtr(bco,bcoInstr(bco,pc++));
- /* ToDo: print contents of infotable */
- fprintf(stderr,"%s ",i);
- printPtr(stgCast(StgPtr,info));
- return pc;
-}
+ switch (instrs[pc++]) {
+ case bci_SWIZZLE:
+ debugBelch("SWIZZLE stkoff %d by %d\n",
+ instrs[pc], (signed int)instrs[pc+1]);
+ pc += 2; break;
+ case bci_CCALL:
+ debugBelch("CCALL marshaller at 0x%x\n",
+ literals[instrs[pc]] );
+ pc += 1; break;
+ case bci_STKCHECK:
+ debugBelch("STKCHECK %d\n", instrs[pc] );
+ pc += 1; break;
+ case bci_PUSH_L:
+ debugBelch("PUSH_L %d\n", instrs[pc] );
+ pc += 1; break;
+ case bci_PUSH_LL:
+ debugBelch("PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] );
+ pc += 2; break;
+ case bci_PUSH_LLL:
+ debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1],
+ instrs[pc+2] );
+ pc += 3; break;
+ case bci_PUSH_G:
+ debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n" );
+ pc += 1; break;
-static InstrPtr disConstPtr ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInt o = bcoInstr(bco,pc++);
- StgPtr x = bcoConstPtr(bco,o);
- fprintf(stderr,"%s [%d]=",i,o);
- printPtr(x); /* bad way to print it... */
- return pc;
-}
+ 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;
-static InstrPtr disConst2Ptr ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgWord o1 = bcoInstr(bco,pc++);
- StgWord o2 = bcoInstr(bco,pc++);
- StgWord o = o1*256 + o2;
- StgPtr x = bcoConstPtr(bco,o);
- fprintf(stderr,"%s [%d]=",i,o);
- printPtr(x); /* bad way to print it... */
- return pc;
-}
+ case bci_PUSH_UBX:
+ debugBelch("PUSH_UBX ");
+ for (i = 0; i < instrs[pc+1]; i++)
+ debugBelch("0x%x ", literals[i + instrs[pc]] );
+ debugBelch("\n");
+ pc += 2; 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:
+ debugBelch("SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] );
+ pc += 2; break;
+ 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:
+ debugBelch("MKAP %d words, %d stkoff\n", instrs[pc+1],
+ instrs[pc] );
+ pc += 2; break;
+ case bci_UNPACK:
+ debugBelch("UNPACK %d\n", instrs[pc] );
+ pc += 1; break;
+ case bci_PACK:
+ debugBelch("PACK %d words with itbl ", instrs[pc+1] );
+ printPtr( (StgPtr)itbls[instrs[pc]] );
+ debugBelch("\n");
+ pc += 2; break;
-static InstrPtr disConstInt ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s %d",i,x);
- return pc;
-}
-
-static InstrPtr disConstAddr ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgAddr x = bcoConstAddr(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s ",i);
- printPtr(x);
- return pc;
-}
-
-static InstrPtr disConstChar ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgChar x = bcoConstChar(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s '%c'",i,x);
- return pc;
-}
+ case bci_TESTLT_I:
+ debugBelch("TESTLT_I %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
+ case bci_TESTEQ_I:
+ debugBelch("TESTEQ_I %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
-static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgFloat x = bcoConstFloat(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s %f",i,x);
- return pc;
-}
+ case bci_TESTLT_F:
+ debugBelch("TESTLT_F %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
+ case bci_TESTEQ_F:
+ debugBelch("TESTEQ_F %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
-static InstrPtr disConstDouble ( StgBCO *bco, InstrPtr pc, char* i )
-{
- StgDouble x = bcoConstDouble(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s %f",i,x);
- return pc;
-}
+ case bci_TESTLT_D:
+ debugBelch("TESTLT_D %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
+ case bci_TESTEQ_D:
+ debugBelch("TESTEQ_D %d, fail to %d\n", literals[instrs[pc]],
+ instrs[pc+1]);
+ pc += 2; break;
-InstrPtr disInstr( StgBCO *bco, InstrPtr pc )
-{
- Instr in;
- ASSERT(pc < bco->n_instrs);
- in = bcoInstr(bco,pc++);
- switch (in) {
- case i_INTERNAL_ERROR:
- return disNone(bco,pc,"INTERNAL_ERROR");
- case i_PANIC:
- return disNone(bco,pc,"PANIC");
- case i_HP_CHECK:
- return disInt(bco,pc,"HP_CHECK");
- case i_STK_CHECK:
- return disInt(bco,pc,"STK_CHECK");
- case i_ARG_CHECK:
- return disInt(bco,pc,"ARG_CHECK");
- case i_ALLOC_AP:
- return disInt(bco,pc,"ALLOC_AP");
- case i_ALLOC_PAP:
- return disInt(bco,pc,"ALLOC_PAP");
- case i_ALLOC_CONSTR:
- return disInfo(bco,pc,"ALLOC_CONSTR");
- case i_MKAP:
- return disIntInt(bco,pc,"MKAP");
- case i_MKPAP:
- return disIntInt(bco,pc,"MKPAP");
- case i_PACK:
- return disInt(bco,pc,"PACK");
- case i_SLIDE:
- return disIntInt(bco,pc,"SLIDE");
- case i_ENTER:
- return disNone(bco,pc,"ENTER");
- case i_RETADDR:
- return disConstPtr(bco,pc,"RETADDR");
- case i_TEST:
- return disIntPC(bco,pc,"TEST");
- case i_UNPACK:
- return disNone(bco,pc,"UNPACK");
- case i_VAR:
- return disInt(bco,pc,"VAR");
- case i_CONST:
- return disConstPtr(bco,pc,"CONST");
- case i_CONST2:
- return disConst2Ptr(bco,pc,"CONST2");
+ case bci_TESTLT_P:
+ debugBelch("TESTLT_P %d, fail to %d\n", instrs[pc],
+ instrs[pc+1]);
+ pc += 2; break;
+ case bci_TESTEQ_P:
+ debugBelch("TESTEQ_P %d, fail to %d\n", instrs[pc],
+ instrs[pc+1]);
+ pc += 2; break;
+ case bci_CASEFAIL:
+ debugBelch("CASEFAIL\n" );
+ break;
+ case bci_JMP:
+ debugBelch("JMP to %d\n", instrs[pc]);
+ pc += 1; break;
- case i_VOID:
- return disNone(bco,pc,"VOID");
+ case bci_ENTER:
+ debugBelch("ENTER\n");
+ break;
- case i_RETURN_GENERIC:
- return disNone(bco,pc,"RETURN_GENERIC");
+ 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;
- case i_VAR_INT:
- return disInt(bco,pc,"VAR_INT");
- case i_CONST_INT:
- return disConstInt(bco,pc,"CONST_INT");
- case i_RETURN_INT:
- return disNone(bco,pc,"RETURN_INT");
- case i_PACK_INT:
- return disNone(bco,pc,"PACK_INT");
- case i_UNPACK_INT:
- return disNone(bco,pc,"UNPACK_INT");
- case i_TEST_INT:
- return disPC(bco,pc,"TEST_INT");
+ default:
+ barf("disInstr: unknown opcode");
+ }
+ return pc;
+}
-#ifdef PROVIDE_INT64
- case i_VAR_INT64:
- return disInt(bco,pc,"VAR_INT64");
- case i_CONST_INT64:
- return disConstInt(bco,pc,"CONST_INT64");
- case i_RETURN_INT64:
- return disNone(bco,pc,"RETURN_INT64");
- case i_PACK_INT64:
- return disNone(bco,pc,"PACK_INT64");
- case i_UNPACK_INT64:
- return disNone(bco,pc,"UNPACK_INT64");
-#endif
-#ifdef PROVIDE_INTEGER
- case i_CONST_INTEGER:
- return disConstAddr(bco,pc,"CONST_INTEGER");
-#endif
-#ifdef PROVIDE_WORD
- case i_VAR_WORD:
- return disInt(bco,pc,"VAR_WORD");
- case i_CONST_WORD:
- return disConstInt(bco,pc,"CONST_WORD");
- case i_RETURN_WORD:
- return disNone(bco,pc,"RETURN_WORD");
- case i_PACK_WORD:
- return disNone(bco,pc,"PACK_WORD");
- case i_UNPACK_WORD:
- return disNone(bco,pc,"UNPACK_WORD");
-#endif
-#ifdef PROVIDE_ADDR
- case i_VAR_ADDR:
- return disInt(bco,pc,"VAR_ADDR");
- case i_CONST_ADDR:
- return disConstAddr(bco,pc,"CONST_ADDR");
- case i_RETURN_ADDR:
- return disNone(bco,pc,"RETURN_ADDR");
- case i_PACK_ADDR:
- return disNone(bco,pc,"PACK_ADDR");
- case i_UNPACK_ADDR:
- return disNone(bco,pc,"UNPACK_ADDR");
-#endif
- case i_VAR_CHAR:
- return disInt(bco,pc,"VAR_CHAR");
- case i_CONST_CHAR:
- return disConstChar(bco,pc,"CONST_CHAR");
- case i_RETURN_CHAR:
- return disNone(bco,pc,"RETURN_CHAR");
- case i_PACK_CHAR:
- return disNone(bco,pc,"PACK_CHAR");
- case i_UNPACK_CHAR:
- return disNone(bco,pc,"UNPACK_CHAR");
- case i_VAR_FLOAT:
- return disInt(bco,pc,"VAR_FLOAT");
- case i_CONST_FLOAT:
- return disConstFloat(bco,pc,"CONST_FLOAT");
- case i_RETURN_FLOAT:
- return disNone(bco,pc,"RETURN_FLOAT");
- case i_PACK_FLOAT:
- return disNone(bco,pc,"PACK_FLOAT");
- case i_UNPACK_FLOAT:
- return disNone(bco,pc,"UNPACK_FLOAT");
+/* Something of a kludge .. how do we know where the end of the insn
+ array is, since it isn't recorded anywhere? Answer: the first
+ short is the number of bytecodes which follow it.
+ See ByteCodeGen.linkBCO.insns_arr for construction ...
+*/
+void disassemble( StgBCO *bco )
+{
+ nat i, j;
+ StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
+ StgMutArrPtrs* ptrs = bco->ptrs;
+ nat nbcs = (int)instrs[0];
+ nat pc = 1;
- case i_VAR_DOUBLE:
- return disInt(bco,pc,"VAR_DOUBLE");
- case i_CONST_DOUBLE:
- return disConstDouble(bco,pc,"CONST_DOUBLE");
- case i_RETURN_DOUBLE:
- return disNone(bco,pc,"RETURN_DOUBLE");
- case i_PACK_DOUBLE:
- return disNone(bco,pc,"PACK_DOUBLE");
- case i_UNPACK_DOUBLE:
- return disNone(bco,pc,"UNPACK_DOUBLE");
+ debugBelch("BCO\n" );
+ pc = 1;
+ while (pc <= nbcs) {
+ debugBelch("\t%2d: ", pc );
+ pc = disInstr ( bco, pc );
+ }
-#ifdef PROVIDE_STABLE
- case i_VAR_STABLE:
- return disInt(bco,pc,"VAR_STABLE");
- case i_RETURN_STABLE:
- return disNone(bco,pc,"RETURN_STABLE");
- case i_PACK_STABLE:
- return disNone(bco,pc,"PACK_STABLE");
- case i_UNPACK_STABLE:
- return disNone(bco,pc,"UNPACK_STABLE");
-#endif
+ debugBelch("INSTRS:\n " );
+ j = 16;
+ for (i = 0; i < nbcs; i++) {
+ debugBelch("%3d ", (int)instrs[i] );
+ j--;
+ if (j == 0) { j = 16; debugBelch("\n "); };
+ }
+ debugBelch("\n");
- case i_PRIMOP1:
- {
- Primop1 op = bcoInstr(bco,pc++);
- switch (op) {
- case i_INTERNAL_ERROR1:
- return disNone(bco,pc,"INTERNAL_ERROR1");
- default:
- {
- const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
- if (p) {
- return disNone(bco,pc,p->name);
- }
- barf("Unrecognised primop1 %d\n",op);
- }
- }
- }
- case i_PRIMOP2:
- {
- Primop2 op = bcoInstr(bco,pc++);
- switch (op) {
- case i_INTERNAL_ERROR2:
- return disNone(bco,pc,"INTERNAL_ERROR2");
- case i_ccall_Id:
- return disNone(bco,pc,"ccall_Id");
- case i_ccall_IO:
- return disNone(bco,pc,"ccall_IO");
- default:
- {
- const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
- if (p) {
- return disNone(bco,pc,p->name);
- }
- barf("Unrecognised primop2 %d\n",op);
- }
- }
- }
- default:
- barf("Unrecognised instruction %d\n",in);
- }
-}
+ debugBelch("PTRS:\n " );
+ j = 8;
+ for (i = 0; i < ptrs->ptrs; i++) {
+ debugBelch("%8p ", ptrs->payload[i] );
+ j--;
+ if (j == 0) { j = 8; debugBelch("\n "); };
+ }
+ debugBelch("\n");
-void disassemble( StgBCO *bco, char* prefix )
-{
- int pc = 0;
- int pcLim = bco->n_instrs;
- ASSERT( get_itbl(bco)->type == BCO);
- while (pc < pcLim) {
- fprintf(stderr,"%s%d:\t",prefix,pc);
- pc = disInstr(bco,pc);
- fprintf(stderr,"\n");
- }
+ debugBelch("\n");
+ ASSERT(pc == nbcs+1);
}
-#endif /* INTERPRETER */
+#endif /* DEBUG */