ghc/rts/Disassembler.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode disassembler
   4  *
   5  * Copyright (c) 1994-1998.
   6  *
   7  * $RCSfile: Disassembler.c,v $
   8  * $Revision: 1.4 $
   9  * $Date: 1999/03/01 14:47:05 $
  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 disIntInt    ( StgBCO *bco, InstrPtr pc, char* i )
  50 {
  51     StgInt x = bcoInstr(bco,pc++);
  52     StgInt y = bcoInstr(bco,pc++);
  53     fprintf(stderr,"%s %d %d",i,x,y);
  54     return pc;
  55 }
  56
  57 static InstrPtr disIntPC     ( StgBCO *bco, InstrPtr pc, char* i )
  58 {
  59     StgInt  x = bcoInstr(bco,pc++);
  60     StgWord y = bcoInstr(bco,pc++);
  61     fprintf(stderr,"%s %d %d",i,x,pc+y);
  62     return pc;
  63 }
  64
  65 static InstrPtr disPC        ( StgBCO *bco, InstrPtr pc, char* i )
  66 {
  67     StgWord y = bcoInstr(bco,pc++);
  68     fprintf(stderr,"%s %d",i,pc+y);
  69     return pc;
  70 }
  71
  72 static InstrPtr disInfo   ( StgBCO *bco, InstrPtr pc, char* i )
  73 {
  74     StgInfoTable* info = bcoConstInfoPtr(bco,bcoInstr(bco,pc++));
  75     /* ToDo: print contents of infotable */
  76     fprintf(stderr,"%s ",i);
  77     printPtr(stgCast(StgPtr,info));
  78     return pc;
  79 }
  80
  81 static InstrPtr disConstPtr  ( StgBCO *bco, InstrPtr pc, char* i )
  82 {
  83     StgInt o = bcoInstr(bco,pc++);
  84     StgPtr x = bcoConstPtr(bco,o);
  85     fprintf(stderr,"%s [%d]=",i,o);
  86     printPtr(x); /* bad way to print it... */
  87     return pc;
  88 }
  89
  90 static InstrPtr disConst2Ptr ( StgBCO *bco, InstrPtr pc, char* i )
  91 {
  92     StgWord o1 = bcoInstr(bco,pc++);
  93     StgWord o2 = bcoInstr(bco,pc++);
  94     StgWord o  = o1*256 + o2;
  95     StgPtr x = bcoConstPtr(bco,o);
  96     fprintf(stderr,"%s [%d]=",i,o);
  97     printPtr(x); /* bad way to print it... */
  98     return pc;
  99 }
 100
 101 static InstrPtr disConstInt  ( StgBCO *bco, InstrPtr pc, char* i )
 102 {
 103     StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++));
 104     fprintf(stderr,"%s %d",i,x);
 105     return pc;
 106 }
 107
 108 static InstrPtr disConstAddr ( StgBCO *bco, InstrPtr pc, char* i )
 109 {
 110     StgAddr x = bcoConstAddr(bco,bcoInstr(bco,pc++));
 111     fprintf(stderr,"%s ",i);
 112     printPtr(x);
 113     return pc;
 114 }
 115
 116 static InstrPtr disConstChar ( StgBCO *bco, InstrPtr pc, char* i )
 117 {
 118     StgChar x = bcoConstChar(bco,bcoInstr(bco,pc++));
 119     if (isprint((int)x))
 120        fprintf(stderr,"%s '%c'",i,x); else
 121        fprintf(stderr,"%s 0x%x",i,(int)x);
 122     return pc;
 123 }
 124
 125 static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i )
 126 {
 127     StgFloat x = bcoConstFloat(bco,bcoInstr(bco,pc++));
 128     fprintf(stderr,"%s %f",i,x);
 129     return pc;
 130 }
 131
 132 static InstrPtr disConstDouble ( StgBCO *bco, InstrPtr pc, char* i )
 133 {
 134     StgDouble x = bcoConstDouble(bco,bcoInstr(bco,pc++));
 135     fprintf(stderr,"%s %f",i,x);
 136     return pc;
 137 }
 138
 139 InstrPtr disInstr( StgBCO *bco, InstrPtr pc )
 140 {
 141     Instr in;
 142     ASSERT(pc < bco->n_instrs);
 143     in = bcoInstr(bco,pc++);
 144     switch (in) {
 145     case i_INTERNAL_ERROR:
 146             return disNone(bco,pc,"INTERNAL_ERROR");
 147     case i_PANIC:
 148             return disNone(bco,pc,"PANIC");
 149     case i_HP_CHECK:
 150             return disInt(bco,pc,"HP_CHECK");
 151     case i_STK_CHECK:
 152             return disInt(bco,pc,"STK_CHECK");
 153     case i_ARG_CHECK:
 154             return disInt(bco,pc,"ARG_CHECK");
 155     case i_ALLOC_AP:
 156             return disInt(bco,pc,"ALLOC_AP");
 157     case i_ALLOC_PAP:
 158             return disInt(bco,pc,"ALLOC_PAP");
 159     case i_ALLOC_CONSTR:
 160             return disInfo(bco,pc,"ALLOC_CONSTR");
 161     case i_MKAP:
 162             return disIntInt(bco,pc,"MKAP");
 163     case i_MKPAP:
 164             return disIntInt(bco,pc,"MKPAP");
 165     case i_PACK:
 166             return disInt(bco,pc,"PACK");
 167     case i_SLIDE:
 168             return disIntInt(bco,pc,"SLIDE");
 169     case i_ENTER:
 170             return disNone(bco,pc,"ENTER");
 171     case i_RETADDR:
 172             return disConstPtr(bco,pc,"RETADDR");
 173     case i_TEST:
 174             return disIntPC(bco,pc,"TEST");
 175     case i_UNPACK:
 176             return disNone(bco,pc,"UNPACK");
 177     case i_VAR:
 178             return disInt(bco,pc,"VAR");
 179     case i_CONST:
 180             return disConstPtr(bco,pc,"CONST");
 181     case i_CONST2:
 182             return disConst2Ptr(bco,pc,"CONST2");
 183
 184     case i_VOID:
 185             return disNone(bco,pc,"VOID");
 186     case i_RETURN_GENERIC:
 187             return disNone(bco,pc,"RETURN_GENERIC");
 188
 189     case i_VAR_INT:
 190             return disInt(bco,pc,"VAR_INT");
 191     case i_CONST_INT:
 192             return disConstInt(bco,pc,"CONST_INT");
 193     case i_RETURN_INT:
 194             return disNone(bco,pc,"RETURN_INT");
 195     case i_PACK_INT:
 196             return disNone(bco,pc,"PACK_INT");
 197     case i_UNPACK_INT:
 198             return disNone(bco,pc,"UNPACK_INT");
 199     case i_TEST_INT:
 200             return disPC(bco,pc,"TEST_INT");
 201
 202 #ifdef PROVIDE_INT64
 203     case i_VAR_INT64:
 204             return disInt(bco,pc,"VAR_INT64");
 205     case i_CONST_INT64:
 206             return disConstInt(bco,pc,"CONST_INT64");
 207     case i_RETURN_INT64:
 208             return disNone(bco,pc,"RETURN_INT64");
 209     case i_PACK_INT64:
 210             return disNone(bco,pc,"PACK_INT64");
 211     case i_UNPACK_INT64:
 212             return disNone(bco,pc,"UNPACK_INT64");
 213 #endif
 214 #ifdef PROVIDE_INTEGER
 215     case i_CONST_INTEGER:
 216             return disConstAddr(bco,pc,"CONST_INTEGER");
 217 #endif
 218 #ifdef PROVIDE_WORD
 219     case i_VAR_WORD:
 220             return disInt(bco,pc,"VAR_WORD");
 221     case i_CONST_WORD:
 222             return disConstInt(bco,pc,"CONST_WORD");
 223     case i_RETURN_WORD:
 224             return disNone(bco,pc,"RETURN_WORD");
 225     case i_PACK_WORD:
 226             return disNone(bco,pc,"PACK_WORD");
 227     case i_UNPACK_WORD:
 228             return disNone(bco,pc,"UNPACK_WORD");
 229 #endif
 230 #ifdef PROVIDE_ADDR
 231     case i_VAR_ADDR:
 232             return disInt(bco,pc,"VAR_ADDR");
 233     case i_CONST_ADDR:
 234             return disConstAddr(bco,pc,"CONST_ADDR");
 235     case i_RETURN_ADDR:
 236             return disNone(bco,pc,"RETURN_ADDR");
 237     case i_PACK_ADDR:
 238             return disNone(bco,pc,"PACK_ADDR");
 239     case i_UNPACK_ADDR:
 240             return disNone(bco,pc,"UNPACK_ADDR");
 241 #endif
 242     case i_VAR_CHAR:
 243             return disInt(bco,pc,"VAR_CHAR");
 244     case i_CONST_CHAR:
 245             return disConstChar(bco,pc,"CONST_CHAR");
 246     case i_RETURN_CHAR:
 247             return disNone(bco,pc,"RETURN_CHAR");
 248     case i_PACK_CHAR:
 249             return disNone(bco,pc,"PACK_CHAR");
 250     case i_UNPACK_CHAR:
 251             return disNone(bco,pc,"UNPACK_CHAR");
 252
 253     case i_VAR_FLOAT:
 254             return disInt(bco,pc,"VAR_FLOAT");
 255     case i_CONST_FLOAT:
 256             return disConstFloat(bco,pc,"CONST_FLOAT");
 257     case i_RETURN_FLOAT:
 258             return disNone(bco,pc,"RETURN_FLOAT");
 259     case i_PACK_FLOAT:
 260             return disNone(bco,pc,"PACK_FLOAT");
 261     case i_UNPACK_FLOAT:
 262             return disNone(bco,pc,"UNPACK_FLOAT");
 263
 264     case i_VAR_DOUBLE:
 265             return disInt(bco,pc,"VAR_DOUBLE");
 266     case i_CONST_DOUBLE:
 267             return disConstDouble(bco,pc,"CONST_DOUBLE");
 268     case i_RETURN_DOUBLE:
 269             return disNone(bco,pc,"RETURN_DOUBLE");
 270     case i_PACK_DOUBLE:
 271             return disNone(bco,pc,"PACK_DOUBLE");
 272     case i_UNPACK_DOUBLE:
 273             return disNone(bco,pc,"UNPACK_DOUBLE");
 274
 275 #ifdef PROVIDE_STABLE
 276     case i_VAR_STABLE:
 277             return disInt(bco,pc,"VAR_STABLE");
 278     case i_RETURN_STABLE:
 279             return disNone(bco,pc,"RETURN_STABLE");
 280     case i_PACK_STABLE:
 281             return disNone(bco,pc,"PACK_STABLE");
 282     case i_UNPACK_STABLE:
 283             return disNone(bco,pc,"UNPACK_STABLE");
 284 #endif
 285
 286     case i_PRIMOP1:
 287         {
 288             Primop1 op = bcoInstr(bco,pc++);
 289             switch (op) {
 290             case i_INTERNAL_ERROR1:
 291                     return disNone(bco,pc,"INTERNAL_ERROR1");
 292             case i_pushseqframe:
 293                     return disNone(bco,pc,"i_pushseqframe");
 294             case i_pushcatchframe:
 295                     return disNone(bco,pc,"i_pushcatchframe");
 296             default:
 297                 {
 298                     const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
 299                     if (p) {
 300                         return disNone(bco,pc,p->name);
 301                     }
 302                     barf("Unrecognised primop1 %d\n",op);
 303                 }
 304             }
 305         }
 306     case i_PRIMOP2:
 307         {
 308             Primop2 op = bcoInstr(bco,pc++);
 309             switch (op) {
 310             case i_INTERNAL_ERROR2:
 311                     return disNone(bco,pc,"INTERNAL_ERROR2");
 312             case i_ccall_Id:
 313                     return disNone(bco,pc,"ccall_Id");
 314             case i_ccall_IO:
 315                     return disNone(bco,pc,"ccall_IO");
 316             case i_raise:
 317                     return disNone(bco,pc,"primRaise");
 318             default:
 319                 {
 320                     const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
 321                     if (p) {
 322                         return disNone(bco,pc,p->name);
 323                     }
 324                     barf("Unrecognised primop2 %d\n",op);
 325                 }
 326             }
 327         }
 328     default:
 329             barf("Unrecognised instruction %d\n",in);
 330     }
 331 }
 332
 333 void  disassemble( StgBCO *bco, char* prefix )
 334 {
 335     int pc = 0;
 336     int pcLim = bco->n_instrs;
 337     ASSERT( get_itbl(bco)->type == BCO);
 338     while (pc < pcLim) {
 339         fprintf(stderr,"%s%d:\t",prefix,pc);
 340         pc = disInstr(bco,pc);
 341         fprintf(stderr,"\n");
 342     }
 343     if (bco->stgexpr) {
 344        ppStgExpr(bco->stgexpr);
 345        fprintf(stderr, "\n");
 346     }
 347     else
 348        fprintf(stderr, "\t(handwritten bytecode)\n" );
 349 }
 350
 351 #endif /* INTERPRETER */