ghc/rts/Disassembler.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode disassembler
   4  *
   5  * Copyright (c) 1994-1998.
   6  *
   7  * $RCSfile: Disassembler.c,v $
   8  * $Revision: 1.7 $
   9  * $Date: 1999/07/06 16:40:24 $
  10  * ---------------------------------------------------------------------------*/
  11
  12 #include "Rts.h"
  13
  14 #ifdef INTERPRETER
  15
  16 #include "RtsUtils.h"
  17 #include "Bytecodes.h"
  18 #include "Assembler.h"
  19 #include "Printer.h"
  20 #include "Disassembler.h"
  21
  22 /* --------------------------------------------------------------------------
  23  * Disassembler
  24  * ------------------------------------------------------------------------*/
  25
  26 static InstrPtr disNone         ( StgBCO *bco, InstrPtr pc, char* i );
  27 static InstrPtr disInt          ( StgBCO *bco, InstrPtr pc, char* i );
  28 static InstrPtr disIntInt       ( StgBCO *bco, InstrPtr pc, char* i );
  29 static InstrPtr disInfo         ( StgBCO *bco, InstrPtr pc, char* i );
  30 static InstrPtr disConstPtr     ( StgBCO *bco, InstrPtr pc, char* i );
  31 static InstrPtr disConstInt     ( StgBCO *bco, InstrPtr pc, char* i );
  32 static InstrPtr disConstChar    ( StgBCO *bco, InstrPtr pc, char* i );
  33 static InstrPtr disConstFloat   ( StgBCO *bco, InstrPtr pc, char* i );
  34
  35 static InstrPtr disNone      ( StgBCO *bco, InstrPtr pc, char* i )
  36 {
  37     fprintf(stderr,"%s",i);
  38     return pc;
  39 }
  40
  41 static InstrPtr disInt       ( StgBCO *bco, InstrPtr pc, char* i )
  42 {
  43     StgInt x = bcoInstr(bco,pc++);
  44     ASSERT(pc <= bco->n_instrs);
  45     fprintf(stderr,"%s %d",i,x);
  46     return pc;
  47 }
  48
  49 static InstrPtr disInt16      ( StgBCO *bco, InstrPtr pc, char* i )
  50 {
  51     StgInt x = bcoInstr16(bco,pc); pc+=2;
  52     ASSERT(pc <= bco->n_instrs);
  53     fprintf(stderr,"%s %d",i,x);
  54     return pc;
  55 }
  56
  57 static InstrPtr disIntInt    ( StgBCO *bco, InstrPtr pc, char* i )
  58 {
  59     StgInt x = bcoInstr(bco,pc++);
  60     StgInt y = bcoInstr(bco,pc++);
  61     fprintf(stderr,"%s %d %d",i,x,y);
  62     return pc;
  63 }
  64
  65 static InstrPtr disIntInt16  ( StgBCO *bco, InstrPtr pc, char* i )
  66 {
  67     StgInt x, y;
  68     x = bcoInstr16(bco,pc); pc += 2;
  69     y = bcoInstr16(bco,pc); pc += 2;
  70     fprintf(stderr,"%s %d %d",i,x,y);
  71     return pc;
  72 }
  73
  74 static InstrPtr disIntPC     ( StgBCO *bco, InstrPtr pc, char* i )
  75 {
  76     StgInt  x;
  77     StgWord y;
  78     x = bcoInstr(bco,pc++);
  79     y = bcoInstr16(bco,pc); pc += 2;
  80     fprintf(stderr,"%s %d %d",i,x,pc+y);
  81     return pc;
  82 }
  83
  84 static InstrPtr disPC        ( StgBCO *bco, InstrPtr pc, char* i )
  85 {
  86     StgWord y = bcoInstr16(bco,pc); pc += 2;
  87     fprintf(stderr,"%s %d",i,pc+y);
  88     return pc;
  89 }
  90
  91 static InstrPtr disInfo   ( StgBCO *bco, InstrPtr pc, char* i )
  92 {
  93     StgInfoTable* info = bcoConstInfoPtr(bco,bcoInstr(bco,pc++));
  94     /* ToDo: print contents of infotable */
  95     fprintf(stderr,"%s ",i);
  96     printPtr(stgCast(StgPtr,info));
  97     return pc;
  98 }
  99
 100 static InstrPtr disConstPtr  ( StgBCO *bco, InstrPtr pc, char* i )
 101 {
 102     StgInt o = bcoInstr(bco,pc++);
 103     StgPtr x = bcoConstPtr(bco,o);
 104     fprintf(stderr,"%s [%d]=",i,o);
 105     printPtr(x); /* bad way to print it... */
 106     return pc;
 107 }
 108
 109 static InstrPtr disConstPtr16 ( StgBCO *bco, InstrPtr pc, char* i )
 110 {
 111     StgInt o;
 112     StgPtr x;
 113     o = bcoInstr16(bco,pc); pc += 2;
 114     x = bcoConstPtr(bco,o);
 115     fprintf(stderr,"%s [%d]=",i,o);
 116     printPtr(x); /* bad way to print it... */
 117     return pc;
 118 }
 119
 120 static InstrPtr disConstInt  ( StgBCO *bco, InstrPtr pc, char* i )
 121 {
 122     StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++));
 123     fprintf(stderr,"%s %d (0x%x)",i,x,x);
 124     return pc;
 125 }
 126
 127 static InstrPtr disConstInt16 ( StgBCO *bco, InstrPtr pc, char* i )
 128 {
 129     StgInt x = bcoConstInt(bco,bcoInstr16(bco,pc)); pc += 2;
 130     fprintf(stderr,"%s %d (0x%x)",i,x,x);
 131     return pc;
 132 }
 133
 134 static InstrPtr disConstAddr ( StgBCO *bco, InstrPtr pc, char* i )
 135 {
 136     StgAddr x = bcoConstAddr(bco,bcoInstr(bco,pc++));
 137     fprintf(stderr,"%s ",i);
 138     printPtr(x);
 139     return pc;
 140 }
 141
 142 static InstrPtr disConstAddr16 ( StgBCO *bco, InstrPtr pc, char* i )
 143 {
 144     StgAddr x = bcoConstAddr(bco,bcoInstr16(bco,pc)); pc += 2;
 145     fprintf(stderr,"%s ",i);
 146     printPtr(x);
 147     return pc;
 148 }
 149
 150 static InstrPtr disConstChar ( StgBCO *bco, InstrPtr pc, char* i )
 151 {
 152     StgChar x = bcoConstChar(bco,bcoInstr(bco,pc++));
 153     if (isprint((int)x))
 154        fprintf(stderr,"%s '%c'",i,x); else
 155        fprintf(stderr,"%s 0x%x",i,(int)x);
 156     return pc;
 157 }
 158
 159 static InstrPtr disConstChar16 ( StgBCO *bco, InstrPtr pc, char* i )
 160 {
 161     StgChar x = bcoConstChar(bco,bcoInstr16(bco,pc)); pc += 2;
 162     if (isprint((int)x))
 163        fprintf(stderr,"%s '%c'",i,x); else
 164        fprintf(stderr,"%s 0x%x",i,(int)x);
 165     return pc;
 166 }
 167
 168 static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i )
 169 {
 170     StgFloat x = bcoConstFloat(bco,bcoInstr(bco,pc++));
 171     fprintf(stderr,"%s %f",i,x);
 172     return pc;
 173 }
 174
 175 static InstrPtr disConstFloat16 ( StgBCO *bco, InstrPtr pc, char* i )
 176 {
 177     StgFloat x = bcoConstFloat(bco,bcoInstr16(bco,pc)); pc += 2;
 178     fprintf(stderr,"%s %f",i,x);
 179     return pc;
 180 }
 181
 182 static InstrPtr disConstDouble ( StgBCO *bco, InstrPtr pc, char* i )
 183 {
 184     StgDouble x = bcoConstDouble(bco,bcoInstr(bco,pc++));
 185     fprintf(stderr,"%s %f",i,x);
 186     return pc;
 187 }
 188
 189 static InstrPtr disConstDouble16 ( StgBCO *bco, InstrPtr pc, char* i )
 190 {
 191     StgDouble x = bcoConstDouble(bco,bcoInstr16(bco,pc)); pc += 2;
 192     fprintf(stderr,"%s %f",i,x);
 193     return pc;
 194 }
 195
 196 InstrPtr disInstr( StgBCO *bco, InstrPtr pc )
 197 {
 198     Instr in;
 199     ASSERT(pc < bco->n_instrs);
 200     in = bcoInstr(bco,pc++);
 201     switch (in) {
 202     case i_INTERNAL_ERROR:
 203             return disNone(bco,pc,"INTERNAL_ERROR");
 204     case i_PANIC:
 205             return disNone(bco,pc,"PANIC");
 206     case i_STK_CHECK:
 207             return disInt(bco,pc,"STK_CHECK");
 208     case i_ARG_CHECK:
 209             return disInt(bco,pc,"ARG_CHECK");
 210     case i_ALLOC_AP:
 211             return disInt(bco,pc,"ALLOC_AP");
 212     case i_ALLOC_PAP:
 213             return disInt(bco,pc,"ALLOC_PAP");
 214     case i_ALLOC_CONSTR:
 215             return disInfo(bco,pc,"ALLOC_CONSTR");
 216     case i_MKAP:
 217             return disIntInt(bco,pc,"MKAP");
 218     case i_MKAP_big:
 219             return disIntInt16(bco,pc,"MKAP_big");
 220     case i_MKPAP:
 221             return disIntInt(bco,pc,"MKPAP");
 222     case i_PACK:
 223             return disInt(bco,pc,"PACK");
 224     case i_SLIDE:
 225             return disIntInt(bco,pc,"SLIDE");
 226     case i_RV:
 227             return disIntInt(bco,pc,"R_V");
 228     case i_RVE:
 229             return disIntInt(bco,pc,"R_V_E");
 230     case i_VV:
 231             return disIntInt(bco,pc,"V_V");
 232     case i_SE:
 233             return disIntInt(bco,pc,"S_E");
 234     case i_SLIDE_big:
 235             return disIntInt16(bco,pc,"SLIDE_big");
 236     case i_ENTER:
 237             return disNone(bco,pc,"ENTER");
 238     case i_RETADDR:
 239             return disConstPtr(bco,pc,"RETADDR");
 240     case i_RETADDR_big:
 241             return disConstPtr16(bco,pc,"RETADDR_big");
 242     case i_TEST:
 243             return disIntPC(bco,pc,"TEST");
 244     case i_UNPACK:
 245             return disNone(bco,pc,"UNPACK");
 246     case i_VAR:
 247             return disInt(bco,pc,"VAR");
 248     case i_VAR_big:
 249             return disInt16(bco,pc,"VAR_big");
 250     case i_CONST:
 251             return disConstPtr(bco,pc,"CONST");
 252     case i_CONST_big:
 253             return disConstPtr16(bco,pc,"CONST_big");
 254
 255     case i_VOID:
 256             return disNone(bco,pc,"VOID");
 257
 258     case i_VAR_INT:
 259             return disInt(bco,pc,"VAR_INT");
 260     case i_VAR_INT_big:
 261             return disInt16(bco,pc,"VAR_INT_big");
 262     case i_CONST_INT:
 263             return disConstInt(bco,pc,"CONST_INT");
 264     case i_CONST_INT_big:
 265             return disConstInt16(bco,pc,"CONST_INT_big");
 266     case i_PACK_INT:
 267             return disNone(bco,pc,"PACK_INT");
 268     case i_UNPACK_INT:
 269             return disNone(bco,pc,"UNPACK_INT");
 270     case i_TEST_INT:
 271             return disPC(bco,pc,"TEST_INT");
 272
 273     case i_CONST_INTEGER:
 274             return disConstAddr(bco,pc,"CONST_INTEGER");
 275     case i_CONST_INTEGER_big:
 276             return disConstAddr16(bco,pc,"CONST_INTEGER_big");
 277
 278     case i_VAR_WORD:
 279             return disInt(bco,pc,"VAR_WORD");
 280     case i_CONST_WORD:
 281             return disConstInt(bco,pc,"CONST_WORD");
 282     case i_PACK_WORD:
 283             return disNone(bco,pc,"PACK_WORD");
 284     case i_UNPACK_WORD:
 285             return disNone(bco,pc,"UNPACK_WORD");
 286
 287     case i_VAR_ADDR:
 288             return disInt(bco,pc,"VAR_ADDR");
 289     case i_VAR_ADDR_big:
 290             return disInt16(bco,pc,"VAR_ADDR_big");
 291     case i_CONST_ADDR:
 292             return disConstAddr(bco,pc,"CONST_ADDR");
 293     case i_CONST_ADDR_big:
 294             return disConstAddr16(bco,pc,"CONST_ADDR_big");
 295     case i_PACK_ADDR:
 296             return disNone(bco,pc,"PACK_ADDR");
 297     case i_UNPACK_ADDR:
 298             return disNone(bco,pc,"UNPACK_ADDR");
 299
 300     case i_VAR_CHAR:
 301             return disInt(bco,pc,"VAR_CHAR");
 302     case i_VAR_CHAR_big:
 303             return disInt16(bco,pc,"VAR_CHAR_big");
 304     case i_CONST_CHAR:
 305             return disConstChar(bco,pc,"CONST_CHAR");
 306     case i_CONST_CHAR_big:
 307             return disConstChar16(bco,pc,"CONST_CHAR_big");
 308     case i_PACK_CHAR:
 309             return disNone(bco,pc,"PACK_CHAR");
 310     case i_UNPACK_CHAR:
 311             return disNone(bco,pc,"UNPACK_CHAR");
 312
 313     case i_VAR_FLOAT:
 314             return disInt(bco,pc,"VAR_FLOAT");
 315     case i_VAR_FLOAT_big:
 316             return disInt16(bco,pc,"VAR_FLOAT_big");
 317     case i_CONST_FLOAT:
 318             return disConstFloat(bco,pc,"CONST_FLOAT");
 319     case i_CONST_FLOAT_big:
 320             return disConstFloat16(bco,pc,"CONST_FLOAT_big");
 321     case i_PACK_FLOAT:
 322             return disNone(bco,pc,"PACK_FLOAT");
 323     case i_UNPACK_FLOAT:
 324             return disNone(bco,pc,"UNPACK_FLOAT");
 325
 326     case i_VAR_DOUBLE:
 327             return disInt(bco,pc,"VAR_DOUBLE");
 328     case i_VAR_DOUBLE_big:
 329             return disInt16(bco,pc,"VAR_DOUBLE_big");
 330     case i_CONST_DOUBLE:
 331             return disConstDouble(bco,pc,"CONST_DOUBLE");
 332     case i_CONST_DOUBLE_big:
 333             return disConstDouble16(bco,pc,"CONST_DOUBLE_big");
 334     case i_PACK_DOUBLE:
 335             return disNone(bco,pc,"PACK_DOUBLE");
 336     case i_UNPACK_DOUBLE:
 337             return disNone(bco,pc,"UNPACK_DOUBLE");
 338
 339 #ifdef PROVIDE_STABLE
 340     case i_VAR_STABLE:
 341             return disInt(bco,pc,"VAR_STABLE");
 342     case i_PACK_STABLE:
 343             return disNone(bco,pc,"PACK_STABLE");
 344     case i_UNPACK_STABLE:
 345             return disNone(bco,pc,"UNPACK_STABLE");
 346 #endif
 347
 348     case i_PRIMOP1:
 349         {
 350             Primop1 op = bcoInstr(bco,pc++);
 351             switch (op) {
 352             case i_INTERNAL_ERROR1:
 353                     return disNone(bco,pc,"INTERNAL_ERROR1");
 354             case i_pushseqframe:
 355                     return disNone(bco,pc,"i_pushseqframe");
 356             case i_pushcatchframe:
 357                     return disNone(bco,pc,"i_pushcatchframe");
 358             default:
 359                 {
 360                     const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
 361                     if (p) {
 362                         return disNone(bco,pc,p->name);
 363                     }
 364                     barf("Unrecognised primop1 %d\n",op);
 365                 }
 366             }
 367         }
 368     case i_PRIMOP2:
 369         {
 370             Primop2 op = bcoInstr(bco,pc++);
 371             switch (op) {
 372             case i_INTERNAL_ERROR2:
 373                     return disNone(bco,pc,"INTERNAL_ERROR2");
 374             case i_ccall_Id:
 375                     return disNone(bco,pc,"ccall_Id");
 376             case i_ccall_IO:
 377                     return disNone(bco,pc,"ccall_IO");
 378             case i_raise:
 379                     return disNone(bco,pc,"primRaise");
 380             default:
 381                 {
 382                     const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
 383                     if (p) {
 384                         return disNone(bco,pc,p->name);
 385                     }
 386                     barf("Unrecognised primop2 %d\n",op);
 387                 }
 388             }
 389         }
 390     default:
 391             barf("Unrecognised instruction %d\n",in);
 392     }
 393 }
 394
 395 void  disassemble( StgBCO *bco, char* prefix )
 396 {
 397     int pc = 0;
 398     int pcLim = bco->n_instrs;
 399     ASSERT( get_itbl(bco)->type == BCO);
 400     while (pc < pcLim) {
 401         fprintf(stderr,"%s%d:\t",prefix,pc);
 402         pc = disInstr(bco,pc);
 403         fprintf(stderr,"\n");
 404     }
 405     if (bco->stgexpr) {
 406        ppStgExpr(bco->stgexpr);
 407        fprintf(stderr, "\n");
 408     }
 409     else
 410        fprintf(stderr, "\t(no associated tree)\n" );
 411 }
 412
 413 #endif /* INTERPRETER */