ghc/rts/Disassembler.c

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