X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FDisassembler.c;h=b084a29b89705135d4d8ec5a6550cacc850178fa;hb=e6218fe7eff4e34e1a3c823cd4b7aebe09d2d4fb;hp=65ef9f4f4ea2c6c20ccfc6bb7461f4764fb4953c;hpb=7f309f1c021e7583f724cce599ce2dd3c439361b;p=ghc-hetmet.git diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 65ef9f4..b084a29 100644 --- a/ghc/rts/Disassembler.c +++ b/ghc/rts/Disassembler.c @@ -1,337 +1,281 @@ -/* -*- mode: hugs-c; -*- */ /* ----------------------------------------------------------------------------- - * $Id: Disassembler.c,v 1.3 1999/02/05 16:02:37 simonm Exp $ - * - * Copyright (c) The GHC Team 1994-1999. - * * Bytecode disassembler * + * Copyright (c) 1994-2002. + * + * $RCSfile: Disassembler.c,v $ + * $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 ) -{ - fprintf(stderr,"%s",i); - return pc; -} - -static InstrPtr disInt ( StgBCO *bco, InstrPtr pc, char* i ) +int +disInstr ( StgBCO *bco, int pc ) { - StgInt x = bcoInstr(bco,pc++); - ASSERT(pc < bco->n_instrs); - fprintf(stderr,"%s %d",i,x); - return pc; -} - -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; -} + int i; -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; -} + StgWord16* instrs = (StgWord16*)(bco->instrs->payload); -static InstrPtr disPC ( StgBCO *bco, InstrPtr pc, char* i ) -{ - StgWord y = bcoInstr(bco,pc++); - fprintf(stderr,"%s %d",i,pc+y); - return pc; -} + StgArrWords* literal_arr = bco->literals; + StgWord* literals = (StgWord*)(&literal_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; -} + StgMutArrPtrs* ptrs_arr = bco->ptrs; + StgPtr* ptrs = (StgPtr*)(&ptrs_arr->payload[0]); -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; -} + StgArrWords* itbls_arr = bco->itbls; + StgInfoTable** itbls = (StgInfoTable**)(&itbls_arr->payload[0]); -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; -} + 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 disConstInt ( StgBCO *bco, InstrPtr pc, char* i ) -{ - StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++)); - fprintf(stderr,"%s %d",i,x); - 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 disConstAddr ( StgBCO *bco, InstrPtr pc, char* i ) -{ - StgAddr x = bcoConstAddr(bco,bcoInstr(bco,pc++)); - fprintf(stderr,"%s ",i); - printPtr(x); - 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 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 */