ghc/rts/Disassembler.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode disassembler
   4  *
   5  * Copyright (c) 1994-1998.
   6  *
   7  * $RCSfile: Disassembler.c,v $
   8  * $Revision: 1.13 $
   9  * $Date: 2000/06/15 13:23:51 $
  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 #ifdef XMLAMBDA
  85 static InstrPtr disInt16PC     ( StgBCO *bco, InstrPtr pc, char* i )
  86 {
  87     StgInt  x;
  88     StgWord y;
  89     x = bcoInstr(bco,pc); pc += 2;
  90     y = bcoInstr16(bco,pc); pc += 2;
  91     fprintf(stderr,"%s %d %d",i,x,pc+y);
  92     return pc;
  93 }
  94 #endif
  95
  96 static InstrPtr disPC        ( StgBCO *bco, InstrPtr pc, char* i )
  97 {
  98     StgWord y = bcoInstr16(bco,pc); pc += 2;
  99     fprintf(stderr,"%s %d",i,pc+y);
 100     return pc;
 101 }
 102
 103 static InstrPtr disInfo   ( StgBCO *bco, InstrPtr pc, char* i )
 104 {
 105     StgInfoTable* info = bcoConstInfoPtr(bco,bcoInstr(bco,pc++));
 106     /* ToDo: print contents of infotable */
 107     fprintf(stderr,"%s ",i);
 108     printPtr(stgCast(StgPtr,info));
 109     return pc;
 110 }
 111
 112 static InstrPtr disInfo16 ( StgBCO *bco, InstrPtr pc, char* i )
 113 {
 114     StgWord x = bcoInstr16(bco,pc);
 115     StgInfoTable* info = bcoConstInfoPtr(bco,x);
 116     pc+=2;
 117     /* ToDo: print contents of infotable */
 118     fprintf(stderr,"%s ",i);
 119     printPtr(stgCast(StgPtr,info));
 120     return pc;
 121 }
 122
 123 static InstrPtr disConstPtr  ( StgBCO *bco, InstrPtr pc, char* i )
 124 {
 125     StgInt o = bcoInstr(bco,pc++);
 126     StgPtr x = bcoConstPtr(bco,o);
 127     fprintf(stderr,"%s [%d]=",i,o);
 128     printPtr(x); /* bad way to print it... */
 129     return pc;
 130 }
 131
 132 static InstrPtr disConstPtr16 ( StgBCO *bco, InstrPtr pc, char* i )
 133 {
 134     StgInt o;
 135     StgPtr x;
 136     o = bcoInstr16(bco,pc); pc += 2;
 137     x = bcoConstPtr(bco,o);
 138     fprintf(stderr,"%s [%d]=",i,o);
 139     printPtr(x); /* bad way to print it... */
 140     return pc;
 141 }
 142
 143 static InstrPtr disConstInt  ( StgBCO *bco, InstrPtr pc, char* i )
 144 {
 145     StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++));
 146     fprintf(stderr,"%s %d (0x%x)",i,x,x);
 147     return pc;
 148 }
 149
 150 static InstrPtr disConstInt16 ( StgBCO *bco, InstrPtr pc, char* i )
 151 {
 152     StgInt x = bcoConstInt(bco,bcoInstr16(bco,pc)); pc += 2;
 153     fprintf(stderr,"%s %d (0x%x)",i,x,x);
 154     return pc;
 155 }
 156
 157 static InstrPtr disConstAddr ( StgBCO *bco, InstrPtr pc, char* i )
 158 {
 159     StgAddr x = bcoConstAddr(bco,bcoInstr(bco,pc++));
 160     fprintf(stderr,"%s ",i);
 161     printPtr(x);
 162     return pc;
 163 }
 164
 165 static InstrPtr disConstAddr16 ( StgBCO *bco, InstrPtr pc, char* i )
 166 {
 167     StgAddr x = bcoConstAddr(bco,bcoInstr16(bco,pc)); pc += 2;
 168     fprintf(stderr,"%s ",i);
 169     printPtr(x);
 170     return pc;
 171 }
 172
 173 static InstrPtr disConstChar ( StgBCO *bco, InstrPtr pc, char* i )
 174 {
 175     StgChar x = bcoConstChar(bco,bcoInstr(bco,pc++));
 176     if (isprint((int)x))
 177        fprintf(stderr,"%s '%c'",i,x); else
 178        fprintf(stderr,"%s 0x%x",i,(int)x);
 179     return pc;
 180 }
 181
 182 static InstrPtr disConstChar16 ( StgBCO *bco, InstrPtr pc, char* i )
 183 {
 184     StgChar x = bcoConstChar(bco,bcoInstr16(bco,pc)); pc += 2;
 185     if (isprint((int)x))
 186        fprintf(stderr,"%s '%c'",i,x); else
 187        fprintf(stderr,"%s 0x%x",i,(int)x);
 188     return pc;
 189 }
 190
 191 static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i )
 192 {
 193     StgFloat x = bcoConstFloat(bco,bcoInstr(bco,pc++));
 194     fprintf(stderr,"%s %f",i,x);
 195     return pc;
 196 }
 197
 198 static InstrPtr disConstFloat16 ( StgBCO *bco, InstrPtr pc, char* i )
 199 {
 200     StgFloat x = bcoConstFloat(bco,bcoInstr16(bco,pc)); pc += 2;
 201     fprintf(stderr,"%s %f",i,x);
 202     return pc;
 203 }
 204
 205 static InstrPtr disConstDouble ( StgBCO *bco, InstrPtr pc, char* i )
 206 {
 207     StgDouble x = bcoConstDouble(bco,bcoInstr(bco,pc++));
 208     fprintf(stderr,"%s %f",i,x);
 209     return pc;
 210 }
 211
 212 static InstrPtr disConstDouble16 ( StgBCO *bco, InstrPtr pc, char* i )
 213 {
 214     StgDouble x = bcoConstDouble(bco,bcoInstr16(bco,pc)); pc += 2;
 215     fprintf(stderr,"%s %f",i,x);
 216     return pc;
 217 }
 218
 219 InstrPtr disInstr( StgBCO *bco, InstrPtr pc )
 220 {
 221     Instr in;
 222     ASSERT(pc < bco->n_instrs);
 223     in = bcoInstr(bco,pc++);
 224     switch (in) {
 225     case i_INTERNAL_ERROR:
 226             return disNone(bco,pc,"INTERNAL_ERROR");
 227     case i_PANIC:
 228             return disNone(bco,pc,"PANIC");
 229     case i_STK_CHECK:
 230             return disInt(bco,pc,"STK_CHECK");
 231     case i_STK_CHECK_big:
 232             return disInt16(bco,pc,"STK_CHECK_big");
 233     case i_ARG_CHECK:
 234             return disInt(bco,pc,"ARG_CHECK");
 235     case i_ALLOC_AP:
 236             return disInt(bco,pc,"ALLOC_AP");
 237     case i_ALLOC_PAP:
 238             return disInt(bco,pc,"ALLOC_PAP");
 239     case i_ALLOC_CONSTR:
 240             return disInfo(bco,pc,"ALLOC_CONSTR");
 241     case i_ALLOC_CONSTR_big:
 242             return disInfo16(bco,pc,"ALLOC_CONSTR_big");
 243     case i_MKAP:
 244             return disIntInt(bco,pc,"MKAP");
 245     case i_MKAP_big:
 246             return disIntInt16(bco,pc,"MKAP_big");
 247     case i_MKPAP:
 248             return disIntInt(bco,pc,"MKPAP");
 249     case i_PACK:
 250             return disInt(bco,pc,"PACK");
 251     case i_SLIDE:
 252             return disIntInt(bco,pc,"SLIDE");
 253     case i_RV:
 254             return disIntInt(bco,pc,"R_V");
 255     case i_RVE:
 256             return disIntInt(bco,pc,"R_V_E");
 257     case i_VV:
 258             return disIntInt(bco,pc,"V_V");
 259     case i_SE:
 260             return disIntInt(bco,pc,"S_E");
 261     case i_SLIDE_big:
 262             return disIntInt16(bco,pc,"SLIDE_big");
 263     case i_ENTER:
 264             return disNone(bco,pc,"ENTER");
 265     case i_RETADDR:
 266             return disConstPtr(bco,pc,"RETADDR");
 267     case i_RETADDR_big:
 268             return disConstPtr16(bco,pc,"RETADDR_big");
 269     case i_TEST:
 270             return disIntPC(bco,pc,"TEST");
 271     case i_UNPACK:
 272             return disNone(bco,pc,"UNPACK");
 273     case i_VAR:
 274             return disInt(bco,pc,"VAR");
 275     case i_VAR_big:
 276             return disInt16(bco,pc,"VAR_big");
 277     case i_CONST:
 278             return disConstPtr(bco,pc,"CONST");
 279     case i_CONST_big:
 280             return disConstPtr16(bco,pc,"CONST_big");
 281
 282 #ifdef XMLAMBDA
 283     case i_ALLOC_ROW:
 284             return disInt(bco,pc,"ALLOC_ROW");
 285     case i_ALLOC_ROW_big:
 286             return disInt16(bco,pc,"ALLOC_ROW_big");
 287     case i_PACK_ROW:
 288             return disInt(bco,pc,"PACK_ROW");
 289     case i_PACK_ROW_big:
 290             return disInt16(bco,pc,"PACK_ROW_big");
 291
 292     case i_PACK_INJ:
 293             return disInt(bco,pc,"PACK_INJ");
 294     case i_PACK_INJ_big:
 295             return disInt16(bco,pc,"PACK_INJ_big");
 296     case i_PACK_INJ_CONST:
 297             return disInt(bco,pc,"PACK_INJ_CONST");
 298
 299     case i_UNPACK_ROW:
 300             return disNone(bco,pc,"UNPACK_ROW");
 301     case i_UNPACK_INJ:
 302             return disNone(bco,pc,"UNPACK_INJ");
 303
 304     case i_TEST_INJ:
 305             return disIntPC(bco,pc,"TEST_INJ");
 306     case i_TEST_INJ_big:
 307             return disInt16PC(bco,pc,"TEST_INJ_big");
 308     case i_TEST_INJ_CONST:
 309             return disIntPC(bco,pc,"TEST_INJ_CONST");
 310 #endif
 311
 312     case i_VOID:
 313             return disNone(bco,pc,"VOID");
 314
 315     case i_VAR_INT:
 316             return disInt(bco,pc,"VAR_INT");
 317     case i_VAR_INT_big:
 318             return disInt16(bco,pc,"VAR_INT_big");
 319     case i_CONST_INT:
 320             return disConstInt(bco,pc,"CONST_INT");
 321     case i_CONST_INT_big:
 322             return disConstInt16(bco,pc,"CONST_INT_big");
 323     case i_PACK_INT:
 324             return disNone(bco,pc,"PACK_INT");
 325     case i_UNPACK_INT:
 326             return disNone(bco,pc,"UNPACK_INT");
 327     case i_TEST_INT:
 328             return disPC(bco,pc,"TEST_INT");
 329
 330     case i_CONST_INTEGER:
 331             return disConstAddr(bco,pc,"CONST_INTEGER");
 332     case i_CONST_INTEGER_big:
 333             return disConstAddr16(bco,pc,"CONST_INTEGER_big");
 334
 335     case i_VAR_WORD:
 336             return disInt(bco,pc,"VAR_WORD");
 337     case i_CONST_WORD:
 338             return disConstInt(bco,pc,"CONST_WORD");
 339     case i_PACK_WORD:
 340             return disNone(bco,pc,"PACK_WORD");
 341     case i_UNPACK_WORD:
 342             return disNone(bco,pc,"UNPACK_WORD");
 343
 344     case i_VAR_ADDR:
 345             return disInt(bco,pc,"VAR_ADDR");
 346     case i_VAR_ADDR_big:
 347             return disInt16(bco,pc,"VAR_ADDR_big");
 348     case i_CONST_ADDR:
 349             return disConstAddr(bco,pc,"CONST_ADDR");
 350     case i_CONST_ADDR_big:
 351             return disConstAddr16(bco,pc,"CONST_ADDR_big");
 352     case i_PACK_ADDR:
 353             return disNone(bco,pc,"PACK_ADDR");
 354     case i_UNPACK_ADDR:
 355             return disNone(bco,pc,"UNPACK_ADDR");
 356
 357     case i_VAR_CHAR:
 358             return disInt(bco,pc,"VAR_CHAR");
 359     case i_VAR_CHAR_big:
 360             return disInt16(bco,pc,"VAR_CHAR_big");
 361     case i_CONST_CHAR:
 362             return disConstChar(bco,pc,"CONST_CHAR");
 363     case i_CONST_CHAR_big:
 364             return disConstChar16(bco,pc,"CONST_CHAR_big");
 365     case i_PACK_CHAR:
 366             return disNone(bco,pc,"PACK_CHAR");
 367     case i_UNPACK_CHAR:
 368             return disNone(bco,pc,"UNPACK_CHAR");
 369
 370     case i_VAR_FLOAT:
 371             return disInt(bco,pc,"VAR_FLOAT");
 372     case i_VAR_FLOAT_big:
 373             return disInt16(bco,pc,"VAR_FLOAT_big");
 374     case i_CONST_FLOAT:
 375             return disConstFloat(bco,pc,"CONST_FLOAT");
 376     case i_CONST_FLOAT_big:
 377             return disConstFloat16(bco,pc,"CONST_FLOAT_big");
 378     case i_PACK_FLOAT:
 379             return disNone(bco,pc,"PACK_FLOAT");
 380     case i_UNPACK_FLOAT:
 381             return disNone(bco,pc,"UNPACK_FLOAT");
 382
 383     case i_VAR_DOUBLE:
 384             return disInt(bco,pc,"VAR_DOUBLE");
 385     case i_VAR_DOUBLE_big:
 386             return disInt16(bco,pc,"VAR_DOUBLE_big");
 387     case i_CONST_DOUBLE:
 388             return disConstDouble(bco,pc,"CONST_DOUBLE");
 389     case i_CONST_DOUBLE_big:
 390             return disConstDouble16(bco,pc,"CONST_DOUBLE_big");
 391     case i_PACK_DOUBLE:
 392             return disNone(bco,pc,"PACK_DOUBLE");
 393     case i_UNPACK_DOUBLE:
 394             return disNone(bco,pc,"UNPACK_DOUBLE");
 395
 396     case i_VAR_STABLE:
 397             return disInt(bco,pc,"VAR_STABLE");
 398     case i_PACK_STABLE:
 399             return disNone(bco,pc,"PACK_STABLE");
 400     case i_UNPACK_STABLE:
 401             return disNone(bco,pc,"UNPACK_STABLE");
 402
 403     case i_PRIMOP1:
 404         {
 405             Primop1 op = bcoInstr(bco,pc++);
 406             switch (op) {
 407             case i_INTERNAL_ERROR1:
 408                     return disNone(bco,pc,"INTERNAL_ERROR1");
 409             case i_pushseqframe:
 410                     return disNone(bco,pc,"i_pushseqframe");
 411             case i_pushcatchframe:
 412                     return disNone(bco,pc,"i_pushcatchframe");
 413             default:
 414                 {
 415                     const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
 416                     if (p) {
 417                         return disNone(bco,pc,p->name);
 418                     }
 419                     barf("Unrecognised primop1 %d\n",op);
 420                 }
 421             }
 422         }
 423     case i_PRIMOP2:
 424         {
 425             Primop2 op = bcoInstr(bco,pc++);
 426             switch (op) {
 427             case i_INTERNAL_ERROR2:
 428                     return disNone(bco,pc,"INTERNAL_ERROR2");
 429             case i_ccall_ccall_Id:
 430                     return disNone(bco,pc,"ccall_ccall_Id");
 431             case i_ccall_ccall_IO:
 432                     return disNone(bco,pc,"ccall_ccall_IO");
 433             case i_ccall_stdcall_Id:
 434                     return disNone(bco,pc,"ccall_stdcall_Id");
 435             case i_ccall_stdcall_IO:
 436                     return disNone(bco,pc,"ccall_stdcall_IO");
 437             case i_raise:
 438                     return disNone(bco,pc,"primRaise");
 439             case i_takeMVar:
 440                     return disNone(bco,pc,"primTakeMVar");
 441             default:
 442                 {
 443                     const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
 444                     if (p) {
 445                         return disNone(bco,pc,p->name);
 446                     }
 447                     barf("Unrecognised primop2 %d\n",op);
 448                 }
 449             }
 450         }
 451     default:
 452             barf("Unrecognised instruction %d\n",in);
 453     }
 454 }
 455
 456 void  disassemble( StgBCO *bco, char* prefix )
 457 {
 458     int pc = 0;
 459     int pcLim = bco->n_instrs;
 460     ASSERT( get_itbl(bco)->type == BCO);
 461     while (pc < pcLim) {
 462         fprintf(stderr,"%s%d:\t",prefix,pc);
 463         pc = disInstr(bco,pc);
 464         fprintf(stderr,"\n");
 465     }
 466     if (bco->stgexpr) {
 467        ppStgExpr(bco->stgexpr);
 468        fprintf(stderr, "\n");
 469     }
 470     else
 471        fprintf(stderr, "\t(no associated tree)\n" );
 472 }
 473
 474 #endif /* INTERPRETER */