ghc/rts/Disassembler.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode disassembler
   4  *
   5  * Copyright (c) 1994-1998.
   6  *
   7  * $RCSfile: Disassembler.c,v $
   8  * $Revision: 1.5 $
   9  * $Date: 1999/03/09 14:51:23 $
  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",i,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",i,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_SLIDE_big:
 227             return disIntInt16(bco,pc,"SLIDE_big");
 228     case i_ENTER:
 229             return disNone(bco,pc,"ENTER");
 230     case i_RETADDR:
 231             return disConstPtr(bco,pc,"RETADDR");
 232     case i_RETADDR_big:
 233             return disConstPtr16(bco,pc,"RETADDR_big");
 234     case i_TEST:
 235             return disIntPC(bco,pc,"TEST");
 236     case i_UNPACK:
 237             return disNone(bco,pc,"UNPACK");
 238     case i_VAR:
 239             return disInt(bco,pc,"VAR");
 240     case i_VAR_big:
 241             return disInt16(bco,pc,"VAR_big");
 242     case i_CONST:
 243             return disConstPtr(bco,pc,"CONST");
 244     case i_CONST_big:
 245             return disConstPtr16(bco,pc,"CONST_big");
 246
 247     case i_VOID:
 248             return disNone(bco,pc,"VOID");
 249     case i_RETURN_GENERIC:
 250             return disNone(bco,pc,"RETURN_GENERIC");
 251
 252     case i_VAR_INT:
 253             return disInt(bco,pc,"VAR_INT");
 254     case i_VAR_INT_big:
 255             return disInt16(bco,pc,"VAR_INT_big");
 256     case i_CONST_INT:
 257             return disConstInt(bco,pc,"CONST_INT");
 258     case i_CONST_INT_big:
 259             return disConstInt16(bco,pc,"CONST_INT_big");
 260     case i_RETURN_INT:
 261             return disNone(bco,pc,"RETURN_INT");
 262     case i_PACK_INT:
 263             return disNone(bco,pc,"PACK_INT");
 264     case i_UNPACK_INT:
 265             return disNone(bco,pc,"UNPACK_INT");
 266     case i_TEST_INT:
 267             return disPC(bco,pc,"TEST_INT");
 268
 269 #ifdef PROVIDE_INT64
 270     case i_VAR_INT64:
 271             return disInt(bco,pc,"VAR_INT64");
 272     case i_CONST_INT64:
 273             return disConstInt(bco,pc,"CONST_INT64");
 274     case i_RETURN_INT64:
 275             return disNone(bco,pc,"RETURN_INT64");
 276     case i_PACK_INT64:
 277             return disNone(bco,pc,"PACK_INT64");
 278     case i_UNPACK_INT64:
 279             return disNone(bco,pc,"UNPACK_INT64");
 280 #endif
 281 #ifdef PROVIDE_INTEGER
 282     case i_CONST_INTEGER:
 283             return disConstAddr(bco,pc,"CONST_INTEGER");
 284     case i_CONST_INTEGER_big:
 285             return disConstAddr16(bco,pc,"CONST_INTEGER_big");
 286 #endif
 287 #ifdef PROVIDE_WORD
 288     case i_VAR_WORD:
 289             return disInt(bco,pc,"VAR_WORD");
 290     case i_CONST_WORD:
 291             return disConstInt(bco,pc,"CONST_WORD");
 292     case i_RETURN_WORD:
 293             return disNone(bco,pc,"RETURN_WORD");
 294     case i_PACK_WORD:
 295             return disNone(bco,pc,"PACK_WORD");
 296     case i_UNPACK_WORD:
 297             return disNone(bco,pc,"UNPACK_WORD");
 298 #endif
 299 #ifdef PROVIDE_ADDR
 300     case i_VAR_ADDR:
 301             return disInt(bco,pc,"VAR_ADDR");
 302     case i_VAR_ADDR_big:
 303             return disInt16(bco,pc,"VAR_ADDR_big");
 304     case i_CONST_ADDR:
 305             return disConstAddr(bco,pc,"CONST_ADDR");
 306     case i_CONST_ADDR_big:
 307             return disConstAddr16(bco,pc,"CONST_ADDR_big");
 308     case i_RETURN_ADDR:
 309             return disNone(bco,pc,"RETURN_ADDR");
 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 #endif
 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_RETURN_CHAR:
 324             return disNone(bco,pc,"RETURN_CHAR");
 325     case i_PACK_CHAR:
 326             return disNone(bco,pc,"PACK_CHAR");
 327     case i_UNPACK_CHAR:
 328             return disNone(bco,pc,"UNPACK_CHAR");
 329
 330     case i_VAR_FLOAT:
 331             return disInt(bco,pc,"VAR_FLOAT");
 332     case i_VAR_FLOAT_big:
 333             return disInt16(bco,pc,"VAR_FLOAT_big");
 334     case i_CONST_FLOAT:
 335             return disConstFloat(bco,pc,"CONST_FLOAT");
 336     case i_CONST_FLOAT_big:
 337             return disConstFloat16(bco,pc,"CONST_FLOAT_big");
 338     case i_RETURN_FLOAT:
 339             return disNone(bco,pc,"RETURN_FLOAT");
 340     case i_PACK_FLOAT:
 341             return disNone(bco,pc,"PACK_FLOAT");
 342     case i_UNPACK_FLOAT:
 343             return disNone(bco,pc,"UNPACK_FLOAT");
 344
 345     case i_VAR_DOUBLE:
 346             return disInt(bco,pc,"VAR_DOUBLE");
 347     case i_VAR_DOUBLE_big:
 348             return disInt16(bco,pc,"VAR_DOUBLE_big");
 349     case i_CONST_DOUBLE:
 350             return disConstDouble(bco,pc,"CONST_DOUBLE");
 351     case i_CONST_DOUBLE_big:
 352             return disConstDouble16(bco,pc,"CONST_DOUBLE_big");
 353     case i_RETURN_DOUBLE:
 354             return disNone(bco,pc,"RETURN_DOUBLE");
 355     case i_PACK_DOUBLE:
 356             return disNone(bco,pc,"PACK_DOUBLE");
 357     case i_UNPACK_DOUBLE:
 358             return disNone(bco,pc,"UNPACK_DOUBLE");
 359
 360 #ifdef PROVIDE_STABLE
 361     case i_VAR_STABLE:
 362             return disInt(bco,pc,"VAR_STABLE");
 363     case i_RETURN_STABLE:
 364             return disNone(bco,pc,"RETURN_STABLE");
 365     case i_PACK_STABLE:
 366             return disNone(bco,pc,"PACK_STABLE");
 367     case i_UNPACK_STABLE:
 368             return disNone(bco,pc,"UNPACK_STABLE");
 369 #endif
 370
 371     case i_PRIMOP1:
 372         {
 373             Primop1 op = bcoInstr(bco,pc++);
 374             switch (op) {
 375             case i_INTERNAL_ERROR1:
 376                     return disNone(bco,pc,"INTERNAL_ERROR1");
 377             case i_pushseqframe:
 378                     return disNone(bco,pc,"i_pushseqframe");
 379             case i_pushcatchframe:
 380                     return disNone(bco,pc,"i_pushcatchframe");
 381             default:
 382                 {
 383                     const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
 384                     if (p) {
 385                         return disNone(bco,pc,p->name);
 386                     }
 387                     barf("Unrecognised primop1 %d\n",op);
 388                 }
 389             }
 390         }
 391     case i_PRIMOP2:
 392         {
 393             Primop2 op = bcoInstr(bco,pc++);
 394             switch (op) {
 395             case i_INTERNAL_ERROR2:
 396                     return disNone(bco,pc,"INTERNAL_ERROR2");
 397             case i_ccall_Id:
 398                     return disNone(bco,pc,"ccall_Id");
 399             case i_ccall_IO:
 400                     return disNone(bco,pc,"ccall_IO");
 401             case i_raise:
 402                     return disNone(bco,pc,"primRaise");
 403             default:
 404                 {
 405                     const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
 406                     if (p) {
 407                         return disNone(bco,pc,p->name);
 408                     }
 409                     barf("Unrecognised primop2 %d\n",op);
 410                 }
 411             }
 412         }
 413     default:
 414             barf("Unrecognised instruction %d\n",in);
 415     }
 416 }
 417
 418 void  disassemble( StgBCO *bco, char* prefix )
 419 {
 420     int pc = 0;
 421     int pcLim = bco->n_instrs;
 422     ASSERT( get_itbl(bco)->type == BCO);
 423     while (pc < pcLim) {
 424         fprintf(stderr,"%s%d:\t",prefix,pc);
 425         pc = disInstr(bco,pc);
 426         fprintf(stderr,"\n");
 427     }
 428     if (bco->stgexpr) {
 429        ppStgExpr(bco->stgexpr);
 430        fprintf(stderr, "\n");
 431     }
 432     else
 433        fprintf(stderr, "\t(no associated tree)\n" );
 434 }
 435
 436 #endif /* INTERPRETER */