ghc/rts/Disassembler.c

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