ghc/rts/Disassembler.c

   1 /* -*- mode: hugs-c; -*- */
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode disassembler
   4  *
   5  * Copyright (c) 1994-1998.
   6  *
   7  * $RCSfile: Disassembler.c,v $
   8  * $Revision: 1.2 $
   9  * $Date: 1998/12/02 13:28:15 $
  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     fprintf(stderr,"%s '%c'",i,x);
 120     return pc;
 121 }
 122
 123 static InstrPtr disConstFloat ( StgBCO *bco, InstrPtr pc, char* i )
 124 {
 125     StgFloat x = bcoConstFloat(bco,bcoInstr(bco,pc++));
 126     fprintf(stderr,"%s %f",i,x);
 127     return pc;
 128 }
 129
 130 static InstrPtr disConstDouble ( StgBCO *bco, InstrPtr pc, char* i )
 131 {
 132     StgDouble x = bcoConstDouble(bco,bcoInstr(bco,pc++));
 133     fprintf(stderr,"%s %f",i,x);
 134     return pc;
 135 }
 136
 137 InstrPtr disInstr( StgBCO *bco, InstrPtr pc )
 138 {
 139     Instr in;
 140     ASSERT(pc < bco->n_instrs);
 141     in = bcoInstr(bco,pc++);
 142     switch (in) {
 143     case i_INTERNAL_ERROR:
 144             return disNone(bco,pc,"INTERNAL_ERROR");
 145     case i_PANIC:
 146             return disNone(bco,pc,"PANIC");
 147     case i_HP_CHECK:
 148             return disInt(bco,pc,"HP_CHECK");
 149     case i_STK_CHECK:
 150             return disInt(bco,pc,"STK_CHECK");
 151     case i_ARG_CHECK:
 152             return disInt(bco,pc,"ARG_CHECK");
 153     case i_ALLOC_AP:
 154             return disInt(bco,pc,"ALLOC_AP");
 155     case i_ALLOC_PAP:
 156             return disInt(bco,pc,"ALLOC_PAP");
 157     case i_ALLOC_CONSTR:
 158             return disInfo(bco,pc,"ALLOC_CONSTR");
 159     case i_MKAP:
 160             return disIntInt(bco,pc,"MKAP");
 161     case i_MKPAP:
 162             return disIntInt(bco,pc,"MKPAP");
 163     case i_PACK:
 164             return disInt(bco,pc,"PACK");
 165     case i_SLIDE:
 166             return disIntInt(bco,pc,"SLIDE");
 167     case i_ENTER:
 168             return disNone(bco,pc,"ENTER");
 169     case i_RETADDR:
 170             return disConstPtr(bco,pc,"RETADDR");
 171     case i_TEST:
 172             return disIntPC(bco,pc,"TEST");
 173     case i_UNPACK:
 174             return disNone(bco,pc,"UNPACK");
 175     case i_VAR:
 176             return disInt(bco,pc,"VAR");
 177     case i_CONST:
 178             return disConstPtr(bco,pc,"CONST");
 179     case i_CONST2:
 180             return disConst2Ptr(bco,pc,"CONST2");
 181
 182     case i_VOID:
 183             return disNone(bco,pc,"VOID");
 184
 185     case i_RETURN_GENERIC:
 186             return disNone(bco,pc,"RETURN_GENERIC");
 187
 188     case i_VAR_INT:
 189             return disInt(bco,pc,"VAR_INT");
 190     case i_CONST_INT:
 191             return disConstInt(bco,pc,"CONST_INT");
 192     case i_RETURN_INT:
 193             return disNone(bco,pc,"RETURN_INT");
 194     case i_PACK_INT:
 195             return disNone(bco,pc,"PACK_INT");
 196     case i_UNPACK_INT:
 197             return disNone(bco,pc,"UNPACK_INT");
 198     case i_TEST_INT:
 199             return disPC(bco,pc,"TEST_INT");
 200
 201 #ifdef PROVIDE_INT64
 202     case i_VAR_INT64:
 203             return disInt(bco,pc,"VAR_INT64");
 204     case i_CONST_INT64:
 205             return disConstInt(bco,pc,"CONST_INT64");
 206     case i_RETURN_INT64:
 207             return disNone(bco,pc,"RETURN_INT64");
 208     case i_PACK_INT64:
 209             return disNone(bco,pc,"PACK_INT64");
 210     case i_UNPACK_INT64:
 211             return disNone(bco,pc,"UNPACK_INT64");
 212 #endif
 213 #ifdef PROVIDE_INTEGER
 214     case i_CONST_INTEGER:
 215             return disConstAddr(bco,pc,"CONST_INTEGER");
 216 #endif
 217 #ifdef PROVIDE_WORD
 218     case i_VAR_WORD:
 219             return disInt(bco,pc,"VAR_WORD");
 220     case i_CONST_WORD:
 221             return disConstInt(bco,pc,"CONST_WORD");
 222     case i_RETURN_WORD:
 223             return disNone(bco,pc,"RETURN_WORD");
 224     case i_PACK_WORD:
 225             return disNone(bco,pc,"PACK_WORD");
 226     case i_UNPACK_WORD:
 227             return disNone(bco,pc,"UNPACK_WORD");
 228 #endif
 229 #ifdef PROVIDE_ADDR
 230     case i_VAR_ADDR:
 231             return disInt(bco,pc,"VAR_ADDR");
 232     case i_CONST_ADDR:
 233             return disConstAddr(bco,pc,"CONST_ADDR");
 234     case i_RETURN_ADDR:
 235             return disNone(bco,pc,"RETURN_ADDR");
 236     case i_PACK_ADDR:
 237             return disNone(bco,pc,"PACK_ADDR");
 238     case i_UNPACK_ADDR:
 239             return disNone(bco,pc,"UNPACK_ADDR");
 240 #endif
 241     case i_VAR_CHAR:
 242             return disInt(bco,pc,"VAR_CHAR");
 243     case i_CONST_CHAR:
 244             return disConstChar(bco,pc,"CONST_CHAR");
 245     case i_RETURN_CHAR:
 246             return disNone(bco,pc,"RETURN_CHAR");
 247     case i_PACK_CHAR:
 248             return disNone(bco,pc,"PACK_CHAR");
 249     case i_UNPACK_CHAR:
 250             return disNone(bco,pc,"UNPACK_CHAR");
 251
 252     case i_VAR_FLOAT:
 253             return disInt(bco,pc,"VAR_FLOAT");
 254     case i_CONST_FLOAT:
 255             return disConstFloat(bco,pc,"CONST_FLOAT");
 256     case i_RETURN_FLOAT:
 257             return disNone(bco,pc,"RETURN_FLOAT");
 258     case i_PACK_FLOAT:
 259             return disNone(bco,pc,"PACK_FLOAT");
 260     case i_UNPACK_FLOAT:
 261             return disNone(bco,pc,"UNPACK_FLOAT");
 262
 263     case i_VAR_DOUBLE:
 264             return disInt(bco,pc,"VAR_DOUBLE");
 265     case i_CONST_DOUBLE:
 266             return disConstDouble(bco,pc,"CONST_DOUBLE");
 267     case i_RETURN_DOUBLE:
 268             return disNone(bco,pc,"RETURN_DOUBLE");
 269     case i_PACK_DOUBLE:
 270             return disNone(bco,pc,"PACK_DOUBLE");
 271     case i_UNPACK_DOUBLE:
 272             return disNone(bco,pc,"UNPACK_DOUBLE");
 273
 274 #ifdef PROVIDE_STABLE
 275     case i_VAR_STABLE:
 276             return disInt(bco,pc,"VAR_STABLE");
 277     case i_RETURN_STABLE:
 278             return disNone(bco,pc,"RETURN_STABLE");
 279     case i_PACK_STABLE:
 280             return disNone(bco,pc,"PACK_STABLE");
 281     case i_UNPACK_STABLE:
 282             return disNone(bco,pc,"UNPACK_STABLE");
 283 #endif
 284
 285     case i_PRIMOP1:
 286         {
 287             Primop1 op = bcoInstr(bco,pc++);
 288             switch (op) {
 289             case i_INTERNAL_ERROR1:
 290                     return disNone(bco,pc,"INTERNAL_ERROR1");
 291             default:
 292                 {
 293                     const AsmPrim* p = asmFindPrimop(i_PRIMOP1,op);
 294                     if (p) {
 295                         return disNone(bco,pc,p->name);
 296                     }
 297                     barf("Unrecognised primop1 %d\n",op);
 298                 }
 299             }
 300         }
 301     case i_PRIMOP2:
 302         {
 303             Primop2 op = bcoInstr(bco,pc++);
 304             switch (op) {
 305             case i_INTERNAL_ERROR2:
 306                     return disNone(bco,pc,"INTERNAL_ERROR2");
 307             case i_ccall_Id:
 308                     return disNone(bco,pc,"ccall_Id");
 309             case i_ccall_IO:
 310                     return disNone(bco,pc,"ccall_IO");
 311             default:
 312                 {
 313                     const AsmPrim* p = asmFindPrimop(i_PRIMOP2,op);
 314                     if (p) {
 315                         return disNone(bco,pc,p->name);
 316                     }
 317                     barf("Unrecognised primop2 %d\n",op);
 318                 }
 319             }
 320         }
 321     default:
 322             barf("Unrecognised instruction %d\n",in);
 323     }
 324 }
 325
 326 void  disassemble( StgBCO *bco, char* prefix )
 327 {
 328     int pc = 0;
 329     int pcLim = bco->n_instrs;
 330     ASSERT( get_itbl(bco)->type == BCO);
 331     while (pc < pcLim) {
 332         fprintf(stderr,"%s%d:\t",prefix,pc);
 333         pc = disInstr(bco,pc);
 334         fprintf(stderr,"\n");
 335     }
 336 }
 337
 338 #endif /* INTERPRETER */